✨ Allow repeated registers after small delay

Helps users with expired tokens proceed with a new register

backend/src/app/rpc.clj

@@ -222,6 +222,7 @@
     (->> (sv/scan-ns 'app.rpc.commands.binfile
                      'app.rpc.commands.comments
                      'app.rpc.commands.management
+                     'app.rpc.commands.verify-token
                      'app.rpc.commands.auth
                      'app.rpc.commands.ldap
                      'app.rpc.commands.demo

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

@@ -6,6 +6,7 @@
 
 (ns app.rpc.commands.auth
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
@@ -184,8 +185,9 @@
 
 ;; ---- COMMAND: Prepare Register
 
-(defn prepare-register
+(defn validate-register-attempt!
-  [{:keys [pool sprops] :as cfg} params]
+  [{:keys [pool sprops]} params]
+
   (when-not (contains? cf/flags :registration)
     (if-not (contains? params :invitation-token)
       (ex/raise :type :restriction
@@ -208,20 +210,46 @@
               :code :email-has-permanent-bounces
               :hint "looks like the email has one or many bounces reported"))
 
-  (check-profile-existence! pool params)
+  ;; Perform a basic validation of email & password
-
   (when (= (str/lower (:email params))
            (str/lower (:password params)))
     (ex/raise :type :validation
               :code :email-as-password
-              :hint "you can't use your email as password"))
+              :hint "you can't use your email as password")))
 
-  (let [params {:email (:email params)
+(def register-retry-threshold
-                :password (:password params)
+  (dt/duration "15m"))
-                :invitation-token (:invitation-token params)
+
-                :backend "penpot"
+(defn- elapsed-register-retry-threshold?
-                :iss :prepared-register
+  [profile]
-                :exp (dt/in-future "48h")}
+  (let [elapsed (dt/diff (:modified-at profile) (dt/now))]
+    (pos? (compare elapsed register-retry-threshold))))
+
+(defn prepare-register
+  [{:keys [pool sprops] :as cfg} params]
+
+  (validate-register-attempt! cfg params)
+
+  (let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))]
+                  (if (:is-active profile)
+                    (ex/raise :type :validation
+                              :code :email-already-exists
+                              :hint "profile already exists and correctly validated")
+                    (if (elapsed-register-retry-threshold? profile)
+                      profile
+                      (ex/raise :type :validation
+                                :code :email-already-exists
+                                :hint "profile already exists"))))
+
+        params  {:email (:email params)
+                 :password (:password params)
+                 :invitation-token (:invitation-token params)
+                 :backend "penpot"
+                 :iss :prepared-register
+                 :profile-id (:id profile)
+                 :exp (dt/in-future {:days 7})}
+
+        params (d/without-nils params)
 
         token  (tokens/generate sprops params)]
     (with-meta {:token token}
@@ -240,11 +268,10 @@
 ;; ---- COMMAND: Register Profile
 
 (defn create-profile
-  "Create the profile entry on the database with limited input filling
+  "Create the profile entry on the database with limited set of input
-  all the other fields with defaults."
+  attrs (all the other attrs are filled with default values)."
   [conn params]
   (let [id        (or (:id params) (uuid/next))
-
         props     (-> (audit/extract-utm-params params)
                       (merge (:props params))
                       (merge {:viewed-tutorial? false
@@ -320,22 +347,36 @@
 
 (defn register-profile
   [{:keys [conn sprops session] :as cfg} {:keys [token] :as params}]
-  (let [claims    (tokens/verify sprops {:token token :iss :prepared-register})
+  (let [claims (tokens/verify sprops {:token token :iss :prepared-register})
-        params    (merge params claims)]
+        params (merge params claims)]
-    (check-profile-existence! conn params)
+
     (let [is-active  (or (:is-active params)
                          (not (contains? cf/flags :email-verification))
 
                          ;; DEPRECATED: v1.15
                          (contains? cf/flags :insecure-register))
 
-          profile    (->> (assoc params :is-active is-active)
+          profile    (if-let [profile-id (:profile-id claims)]
-                          (create-profile conn)
+                       (profile/retrieve-profile conn profile-id)
-                          (create-profile-relations conn)
+                       (->> (assoc params :is-active is-active)
-                          (profile/decode-profile-row))
+                            (create-profile conn)
+                            (create-profile-relations conn)
+                            (profile/decode-profile-row)))
+          audit-fn   (:audit cfg)
 
           invitation (when-let [token (:invitation-token params)]
                        (tokens/verify sprops {:token token :iss :team-invitation}))]
+
+      ;; If profile is filled in claims, means it tries to register
+      ;; again, so we proceed to update the modified-at attr
+      ;; accordingly.
+      (when-let [id (:profile-id claims)]
+        (db/update! conn :profile {:modified-at (dt/now)} {:id id})
+        (audit-fn :cmd :submit
+                  :type "fact"
+                  :name "register-profile-retry"
+                  :profile-id id))
+
       (cond
         ;; If invitation token comes in params, this is because the
         ;; user comes from team-invitation process; in this case,

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

@@ -0,0 +1,191 @@
+;; 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.rpc.commands.verify-token
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.loggers.audit :as audit]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
+   [app.rpc.doc :as-alias doc]
+   [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]))
+
+(s/def ::iss keyword?)
+(s/def ::exp ::us/inst)
+
+(defmulti process-token (fn [_ _ claims] (:iss claims)))
+
+(s/def ::verify-token
+  (s/keys :req-un [::token]
+          :opt-un [::profile-id]))
+
+(sv/defmethod ::verify-token
+  {:auth false
+   ::doc/added "1.15"}
+  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
+  (db/with-atomic [conn pool]
+    (let [claims (tokens/verify sprops {:token token})
+          cfg    (assoc cfg :conn conn)]
+      (process-token cfg params claims))))
+
+(defmethod process-token :change-email
+  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
+  (when (profile/retrieve-profile-data-by-email conn email)
+    (ex/raise :type :validation
+              :code :email-already-exists))
+
+  (db/update! conn :profile
+              {:email email}
+              {:id profile-id})
+
+  (with-meta claims
+    {::audit/name "update-profile-email"
+     ::audit/props {:email email}
+     ::audit/profile-id profile-id}))
+
+(defmethod process-token :verify-email
+  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)
+        claims  (assoc claims :profile profile)]
+
+    (when-not (:is-active profile)
+      (when (not= (:email profile)
+                  (:email claims))
+        (ex/raise :type :validation
+                  :code :invalid-token))
+
+      (db/update! conn :profile
+                  {:is-active true}
+                  {:id (:id profile)}))
+
+    (with-meta claims
+      {:transform-response ((:create session) profile-id)
+       ::audit/name "verify-profile-email"
+       ::audit/props (audit/profile->props profile)
+       ::audit/profile-id (:id profile)})))
+
+(defmethod process-token :auth
+  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)]
+    (assoc claims :profile profile)))
+
+;; --- Team Invitation
+
+(defn- accept-invitation
+  [{:keys [conn] :as cfg} {:keys [member-id team-id role member-email] :as claims} invitation]
+  (let [member (profile/retrieve-profile conn member-id)
+
+        ;; Update the role if there is an invitation
+        role   (or (some-> invitation :role keyword) role)
+        params (merge
+                {:team-id team-id
+                 :profile-id member-id}
+                (teams/role->params role))]
+
+    ;; Insert the invited member to the team
+    (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
+
+    ;; If profile is not yet verified, mark it as verified because
+    ;; accepting an invitation link serves as verification.
+    (when-not (:is-active member)
+      (db/update! conn :profile
+                  {:is-active true}
+                  {:id member-id}))
+
+    ;; Delete the invitation
+    (db/delete! conn :team-invitation
+                {:team-id team-id :email-to member-email})
+
+    (assoc member :is-active true)))
+
+
+(s/def ::spec.team-invitation/profile-id ::us/uuid)
+(s/def ::spec.team-invitation/role ::us/keyword)
+(s/def ::spec.team-invitation/team-id ::us/uuid)
+(s/def ::spec.team-invitation/member-email ::us/email)
+(s/def ::spec.team-invitation/member-id (s/nilable ::us/uuid))
+
+(s/def ::team-invitation-claims
+  (s/keys :req-un [::iss ::exp
+                   ::spec.team-invitation/profile-id
+                   ::spec.team-invitation/role
+                   ::spec.team-invitation/team-id
+                   ::spec.team-invitation/member-email]
+          :opt-un [::spec.team-invitation/member-id]))
+
+(defmethod process-token :team-invitation
+  [{:keys [conn session] :as cfg} {:keys [profile-id token]} {:keys [member-id team-id member-email] :as claims}]
+  (us/assert ::team-invitation-claims claims)
+
+  (let [invitation (db/get-by-params conn :team-invitation
+                                     {:team-id team-id :email-to member-email}
+                                     {:check-not-found false})]
+    (when (nil? invitation)
+      (ex/raise :type :validation
+                :code :invalid-token
+                :hint "no invitation associated with the token"))
+
+    (cond
+      ;; This happens when token is filled with member-id and current
+      ;; user is already logged in with exactly invited account.
+      (and (uuid? profile-id) (uuid? member-id))
+      (if (= member-id profile-id)
+        (let [profile (accept-invitation cfg claims invitation)]
+          (with-meta
+            (assoc claims :state :created)
+            {::audit/name "accept-team-invitation"
+             ::audit/props (merge
+                            (audit/profile->props profile)
+                            {:team-id (:team-id claims)
+                             :role (:role claims)})
+             ::audit/profile-id member-id}))
+        (ex/raise :type :validation
+                  :code :invalid-token
+                  :hint "logged-in user does not matches the invitation"))
+
+      ;; This happens when an unlogged user, uses an invitation link.
+      (and (not profile-id) (uuid? member-id))
+      (let [profile (accept-invitation cfg claims invitation)]
+        (with-meta
+          (assoc claims :state :created)
+          {:transform-response ((:create session) (:id profile))
+           ::audit/name "accept-team-invitation"
+           ::audit/props (merge
+                          (audit/profile->props profile)
+                          {:team-id (:team-id claims)
+                           :role (:role claims)})
+           ::audit/profile-id member-id}))
+
+      ;; This case means that invitation token does not match with
+      ;; registred user, so we need to indicate to frontend to redirect
+      ;; it to register page.
+      (and (not profile-id) (nil? member-id))
+      {:invitation-token token
+       :iss :team-invitation
+       :redirect-to :auth-register
+       :state :pending}
+
+      ;; In all other cases, just tell to fontend to redirect the user
+      ;; to the login page.
+      :else
+      {:invitation-token token
+       :iss :team-invitation
+       :redirect-to :auth-login
+       :state :pending})))
+
+;; --- Default
+
+(defmethod process-token :default
+  [_ _ _]
+  (ex/raise :type :validation
+            :code :invalid-token))
+

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

@@ -399,6 +399,7 @@
   [{:keys [conn sprops team profile role email] :as cfg}]
   (let [member    (profile/retrieve-profile-data-by-email conn email)
         token-exp (dt/in-future "168h") ;; 7 days
+        email     (str/lower email)
         itoken    (tokens/generate sprops
                                    {:iss :team-invitation
                                     :exp token-exp
@@ -412,9 +413,6 @@
                                     :profile-id (:id profile)
                                     :exp (dt/in-future {:days 30})})]
 
-    (when (contains? cf/flags :log-invitation-tokens)
-      (l/trace :hint "invitation token" :token itoken))
-
     (when (and member (not (eml/allow-send-emails? conn member)))
       (ex/raise :type :validation
                 :code :member-is-muted
@@ -428,6 +426,9 @@
                 :email email
                 :hint "the email you invite has been repeatedly reported as spam or bounce"))
 
+    (when (contains? cf/flags :log-invitation-tokens)
+      (l/trace :hint "invitation token" :token itoken))
+
     ;; When we have email verification disabled and invitation user is
     ;; already present in the database, we proceed to add it to the
     ;; team as-is, without email roundtrip.

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

@@ -6,170 +6,23 @@
 
 (ns app.rpc.mutations.verify-token
   (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
    [app.db :as db]
-   [app.loggers.audit :as audit]
-   [app.rpc.mutations.teams :as teams]
-   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
-   [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.commands.verify-token :refer [process-token]]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]
+   [clojure.spec.alpha :as s]))
-   [cuerdas.core :as str]))
-
-(defmulti process-token (fn [_ _ claims] (:iss claims)))
 
 (s/def ::verify-token
   (s/keys :req-un [::token]
           :opt-un [::profile-id]))
 
-(sv/defmethod ::verify-token {:auth false}
+(sv/defmethod ::verify-token
+  {:auth false
+   ::doc/added "1.1"
+   ::doc/deprecated "1.15"}
   [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
   (db/with-atomic [conn pool]
     (let [claims (tokens/verify sprops {:token token})
           cfg    (assoc cfg :conn conn)]
       (process-token cfg params claims))))
-
-(defmethod process-token :change-email
-  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
-  (when (profile/retrieve-profile-data-by-email conn email)
-    (ex/raise :type :validation
-              :code :email-already-exists))
-
-  (db/update! conn :profile
-              {:email email}
-              {:id profile-id})
-
-  (with-meta claims
-    {::audit/name "update-profile-email"
-     ::audit/props {:email email}
-     ::audit/profile-id profile-id}))
-
-(defmethod process-token :verify-email
-  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)
-        claims  (assoc claims :profile profile)]
-
-    (when-not (:is-active profile)
-      (when (not= (:email profile)
-                  (:email claims))
-        (ex/raise :type :validation
-                  :code :invalid-token))
-
-      (db/update! conn :profile
-                  {:is-active true}
-                  {:id (:id profile)}))
-
-    (with-meta claims
-      {:transform-response ((:create session) profile-id)
-       ::audit/name "verify-profile-email"
-       ::audit/props (audit/profile->props profile)
-       ::audit/profile-id (:id profile)})))
-
-(defmethod process-token :auth
-  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)]
-    (assoc claims :profile profile)))
-
-
-;; --- Team Invitation
-
-(s/def ::iss keyword?)
-(s/def ::exp ::us/inst)
-
-(s/def ::spec.team-invitation/profile-id ::us/uuid)
-(s/def ::spec.team-invitation/role ::us/keyword)
-(s/def ::spec.team-invitation/team-id ::us/uuid)
-(s/def ::spec.team-invitation/member-email ::us/email)
-(s/def ::spec.team-invitation/member-id (s/nilable ::us/uuid))
-
-(s/def ::team-invitation-claims
-  (s/keys :req-un [::iss ::exp
-                   ::spec.team-invitation/profile-id
-                   ::spec.team-invitation/role
-                   ::spec.team-invitation/team-id
-                   ::spec.team-invitation/member-email]
-          :opt-un [::spec.team-invitation/member-id]))
-
-(defn- accept-invitation
-  [{:keys [conn] :as cfg} {:keys [member-id team-id role member-email] :as claims}]
-  (let [
-        member (profile/retrieve-profile conn member-id)
-        invitation (db/get-by-params conn :team-invitation
-                                    {:team-id team-id :email-to (str/lower member-email)}
-                                    {:check-not-found false})
-        ;; Update the role if there is an invitation
-        role (or (some-> invitation :role keyword) role)
-        params (merge {:team-id team-id
-                       :profile-id member-id}
-                      (teams/role->params role))
-        ]
-
-    ;; Insert the invited member to the team
-    (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
-
-    ;; If profile is not yet verified, mark it as verified because
-    ;; accepting an invitation link serves as verification.
-    (when-not (:is-active member)
-      (db/update! conn :profile
-                  {:is-active true}
-                  {:id member-id}))
-    (assoc member :is-active true)
-
-    ;; Delete the invitation
-    (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (str/lower member-email)})))
-
-
-(defmethod process-token :team-invitation
-  [cfg {:keys [profile-id token]} {:keys [member-id] :as claims}]
-  (us/assert ::team-invitation-claims claims)
-  (let [conn (:conn cfg)
-        team-id (:team-id claims)
-        member-email (:member-email claims)
-        invitation (db/get-by-params conn :team-invitation
-                                     {:team-id team-id :email-to (str/lower member-email)}
-                                     {:check-not-found false})]
-    (when (nil? invitation)
-      (ex/raise :type :validation
-                :code :invalid-token)))
-
-  (cond
-    ;; This happens when token is filled with member-id and current
-    ;; user is already logged in with exactly invited account.
-    (and (uuid? profile-id) (uuid? member-id) (= member-id profile-id))
-    (let [profile (accept-invitation cfg claims)]
-      (with-meta
-        (assoc claims :state :created)
-        {::audit/name "accept-team-invitation"
-         ::audit/props (merge
-                        (audit/profile->props profile)
-                        {:team-id (:team-id claims)
-                         :role (:role claims)})
-         ::audit/profile-id member-id}))
-
-    ;; This case means that invitation token does not match with
-    ;; registred user, so we need to indicate to frontend to redirect
-    ;; it to register page.
-    (nil? member-id)
-    {:invitation-token token
-     :iss :team-invitation
-     :redirect-to :auth-register
-     :state :pending}
-
-    ;; In all other cases, just tell to fontend to redirect the user
-    ;; to the login page.
-    :else
-    {:invitation-token token
-     :iss :team-invitation
-     :redirect-to :auth-login
-     :state :pending}))
-
-;; --- Default
-
-(defmethod process-token :default
-  [_ _ _]
-  (ex/raise :type :validation
-            :code :invalid-token))
-

backend/test/app/bounce_handling_test.clj

@@ -250,9 +250,10 @@
 
 (t/deftest test-allow-send-messages-predicate-with-bounces
   (with-mocks [mock {:target 'app.config/get
-                     :return (th/mock-config-get-with
+                     :return (th/config-get-mock
                               {:profile-bounce-threshold 3
                                :profile-complaint-threshold 2})}]
+
     (let [profile (th/create-profile* 1)
           pool    (:app.db/pool th/*system*)]
       (th/create-complaint-for pool {:type :bounce :id (:id profile) :created-at (dt/in-past {:days 8})})
@@ -260,7 +261,7 @@
       (th/create-complaint-for pool {:type :bounce :id (:id profile)})
 
       (t/is (true? (emails/allow-send-emails? pool profile)))
-      (t/is (= 4 (:call-count (deref mock))))
+      (t/is (= 4 (:call-count @mock)))
 
       (th/create-complaint-for pool {:type :bounce :id (:id profile)})
       (t/is (false? (emails/allow-send-emails? pool profile))))))
@@ -268,7 +269,7 @@
 
 (t/deftest test-allow-send-messages-predicate-with-complaints
   (with-mocks [mock {:target 'app.config/get
-                     :return (th/mock-config-get-with
+                     :return (th/config-get-mock
                               {:profile-bounce-threshold 3
                                :profile-complaint-threshold 2})}]
     (let [profile (th/create-profile* 1)
@@ -280,7 +281,7 @@
       (th/create-complaint-for pool {:type :complaint :id (:id profile)})
 
       (t/is (true? (emails/allow-send-emails? pool profile)))
-      (t/is (= 4 (:call-count (deref mock))))
+      (t/is (= 4 (:call-count @mock)))
 
       (th/create-complaint-for pool {:type :complaint :id (:id profile)})
       (t/is (false? (emails/allow-send-emails? pool profile))))))

backend/test/app/services_files_test.clj

@@ -539,8 +539,8 @@
                   :components-v2 true}
             {:keys [error result] :as out} (th/query! data)]
         ;; (th/print-result! out)
-        (t/is (= :validation (th/ex-type error)))
+        (t/is (th/ex-of-type? error :validation))
-        (t/is (= :spec-validation (th/ex-code error)))))
+        (t/is (th/ex-of-code? error :spec-validation (th/ex-code error)))))
 
     (t/testing "RPC :file-data-for-thumbnail"
       ;; Insert a thumbnail data for the frame-id
@@ -728,8 +728,8 @@
 
       ;; Then query the specific revn
       (let [{:keys [result error] :as out} (th/query! (assoc data :revn 1))]
-        (t/is (= :not-found (th/ex-type error)))
+        (t/is (th/ex-of-type? error :not-found))
-        (t/is (= :file-thumbnail-not-found (th/ex-code error)))))
+        (t/is (th/ex-of-code? error :file-thumbnail-not-found))))
     ))
 
 

backend/test/app/services_profile_test.clj

@@ -119,15 +119,14 @@
     ))
 
 (t/deftest profile-deletion-simple
-  (let [task (:app.tasks.objects-gc/handler th/*system*)
+  (let [prof (th/create-profile* 1)
-        prof (th/create-profile* 1)
         file (th/create-file* 1 {:profile-id (:id prof)
                                  :project-id (:default-project-id prof)
                                  :is-shared false})]
 
     ;; profile is not deleted because it does not meet all
     ;; conditions to be deleted.
-    (let [result (task {:min-age (dt/duration 0)})]
+    (let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
       (t/is (= 0 (:processed result))))
 
     ;; Request profile to be deleted
@@ -146,7 +145,7 @@
       (t/is (= 1 (count (:result out)))))
 
     ;; execute permanent deletion task
-    (let [result (task {:min-age (dt/duration "-1m")})]
+    (let [result (th/run-task! :objects-gc {:min-age (dt/duration "-1m")})]
       (t/is (= 1 (:processed result))))
 
     ;; query profile after delete
@@ -166,7 +165,7 @@
     (t/testing "not allowed email domain"
       (t/is (false? (cauth/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
 
-(t/deftest prepare-register-and-register-profile
+(t/deftest prepare-register-and-register-profile-1
   (let [data  {::th/type :prepare-register-profile
                :email "user@example.com"
                :password "foobar"}
@@ -195,6 +194,100 @@
         (t/is (nil? error))))
     ))
 
+(t/deftest prepare-register-and-register-profile-1
+  (let [data  {::th/type :prepare-register-profile
+               :email "user@example.com"
+               :password "foobar"}
+        out   (th/mutation! data)
+        token (get-in out [:result :token])]
+    (t/is (string? token))
+
+
+    ;; try register without token
+    (let [data  {::th/type :register-profile
+                 :fullname "foobar"
+                 :accept-terms-and-privacy true}
+          out   (th/mutation! data)]
+      (let [error (:error out)]
+        (t/is (th/ex-info? error))
+        (t/is (th/ex-of-type? error :validation))
+        (t/is (th/ex-of-code? error :spec-validation))))
+
+    ;; try correct register
+    (let [data  {::th/type :register-profile
+                 :token token
+                 :fullname "foobar"
+                 :accept-terms-and-privacy true
+                 :accept-newsletter-subscription true}]
+      (let [{:keys [result error]} (th/mutation! data)]
+        (t/is (nil? error))))
+    ))
+
+(t/deftest prepare-register-and-register-profile-2
+  (with-redefs [app.rpc.commands.auth/register-retry-threshold (dt/duration 500)]
+    (with-mocks [mock {:target 'app.emails/send! :return nil}]
+      (let [current-token (atom nil)]
+
+        ;; PREPARE REGISTER
+        (let [data  {::th/type :prepare-register-profile
+                     :email "hello@example.com"
+                     :password "foobar"}
+              out   (th/command! data)
+              token (get-in out [:result :token])]
+          (t/is (string? token))
+          (reset! current-token token))
+
+        ;; DO REGISTRATION: try correct register attempt 1
+        (let [data  {::th/type :register-profile
+                     :token @current-token
+                     :fullname "foobar"
+                     :accept-terms-and-privacy true
+                     :accept-newsletter-subscription true}
+              out   (th/command! data)]
+          (t/is (nil? (:error out)))
+          (t/is (= 1 (:call-count @mock))))
+
+        (th/reset-mock! mock)
+
+        ;; PREPARE REGISTER without waiting for threshold
+        (let [data  {::th/type :prepare-register-profile
+                     :email "hello@example.com"
+                     :password "foobar"}
+              out   (th/command! data)]
+          (t/is (not (th/success? out)))
+          (t/is (= :validation (-> out :error th/ex-type)))
+          (t/is (= :email-already-exists (-> out :error th/ex-code))))
+
+        (th/sleep {:millis 500})
+        (th/reset-mock! mock)
+
+        ;; PREPARE REGISTER waiting the threshold
+        (let [data  {::th/type :prepare-register-profile
+                     :email "hello@example.com"
+                     :password "foobar"}
+              out   (th/command! data)]
+
+          (t/is (th/success? out))
+          (t/is (= 0 (:call-count @mock)))
+
+          (let [result (:result out)]
+            (t/is (contains? result :token))
+            (reset! current-token (:token result))))
+
+        ;; DO REGISTRATION: try correct register attempt 1
+        (let [data  {::th/type :register-profile
+                     :token @current-token
+                     :fullname "foobar"
+                     :accept-terms-and-privacy true
+                     :accept-newsletter-subscription true}
+              out   (th/command! data)]
+          (t/is (th/success? out))
+          (t/is (= 1 (:call-count @mock))))
+
+        ))
+    ))
+
+
 (t/deftest prepare-and-register-with-invitation-and-disabled-registration-1
   (with-redefs [app.config/flags [:disable-registration]]
     (let [sprops (:app.setup/props th/*system*)
@@ -239,34 +332,39 @@
                  :invitation-token itoken
                  :email "user@example.com"
                  :password "foobar"}
-          {:keys [result error] :as out} (th/mutation! data)]
+          out   (th/command! data)]
-      (t/is (th/ex-info? error))
-      (t/is (= :restriction (th/ex-type error)))
-      (t/is (= :email-does-not-match-invitation (th/ex-code error))))))
 
+      (t/is (not (th/success? out)))
+      (let [edata (-> out :error ex-data)]
+        (t/is (= :restriction (:type edata)))
+        (t/is (= :email-does-not-match-invitation (:code edata))))
+      )))
 
 (t/deftest prepare-register-with-registration-disabled
-  (th/with-mocks {#'app.config/flags nil}
+  (with-redefs [app.config/flags #{}]
     (let [data  {::th/type :prepare-register-profile
                  :email "user@example.com"
-                 :password "foobar"}]
+                 :password "foobar"}
-      (let [{:keys [result error] :as out} (th/mutation! data)]
+          out  (th/command! data)]
-        (t/is (th/ex-info? error))
+
-        (t/is (th/ex-of-type? error :restriction))
+      (t/is (not (th/success? out)))
-        (t/is (th/ex-of-code? error :registration-disabled))))))
+      (let [edata (-> out :error ex-data)]
+        (t/is (= :restriction (:type edata)))
+        (t/is (= :registration-disabled (:code edata)))))))
 
 (t/deftest prepare-register-with-existing-user
   (let [profile (th/create-profile* 1)
         data    {::th/type :prepare-register-profile
                  :email (:email profile)
-                 :password "foobar"}]
+                 :password "foobar"}
-    (let [{:keys [result error] :as out} (th/mutation! data)]
+        out     (th/command! data)]
-      ;; (th/print-result! out)
-      (t/is (th/ex-info? error))
-      (t/is (th/ex-of-type? error :validation))
-      (t/is (th/ex-of-code? error :email-already-exists)))))
 
-(t/deftest test-register-profile-with-bounced-email
+      (t/is (not (th/success? out)))
+      (let [edata (-> out :error ex-data)]
+        (t/is (= :validation (:type edata)))
+        (t/is (= :email-already-exists (:code edata))))))
+
+(t/deftest register-profile-with-bounced-email
   (let [pool  (:app.db/pool th/*system*)
         data  {::th/type :prepare-register-profile
                :email "user@example.com"
@@ -274,34 +372,38 @@
 
     (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
 
-    (let [{:keys [result error] :as out} (th/mutation! data)]
+    (let [out (th/command! data)]
-      (t/is (th/ex-info? error))
+      (t/is (not (th/success? out)))
-      (t/is (th/ex-of-type? error :validation))
+      (let [edata (-> out :error ex-data)]
-      (t/is (th/ex-of-code? error :email-has-permanent-bounces)))))
+        (t/is (= :validation (:type edata)))
+        (t/is (= :email-has-permanent-bounces (:code edata)))))))
 
-(t/deftest test-register-profile-with-complained-email
+(t/deftest register-profile-with-complained-email
   (let [pool  (:app.db/pool th/*system*)
         data  {::th/type :prepare-register-profile
                :email "user@example.com"
                :password "foobar"}]
 
     (th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
-    (let [{:keys [result error] :as out} (th/mutation! data)]
-      (t/is (nil? error))
-      (t/is (string? (:token result))))))
 
-(t/deftest test-register-profile-with-email-as-password
+    (let [out (th/command! data)]
-  (let [data  {::th/type :prepare-register-profile
+      (t/is (th/success? out))
-               :email "user@example.com"
+      (let [result (:result out)]
-               :password "USER@example.com"}]
+        (t/is (contains? result :token))))))
 
-    (let [{:keys [result error] :as out} (th/mutation! data)]
+(t/deftest register-profile-with-email-as-password
-      (t/is (th/ex-info? error))
+  (let [data {::th/type :prepare-register-profile
-      (t/is (th/ex-of-type? error :validation))
+              :email "user@example.com"
-      (t/is (th/ex-of-code? error :email-as-password)))))
+              :password "USER@example.com"}
+        out  (th/command! data)]
 
-(t/deftest test-email-change-request
+    (t/is (not (th/success? out)))
-  (with-mocks [email-send-mock {:target 'app.emails/send! :return nil}]
+    (let [edata (-> out :error ex-data)]
+      (t/is (= :validation (:type edata)))
+      (t/is (= :email-as-password (:code edata))))))
+
+(t/deftest email-change-request
+  (with-mocks [mock {:target 'app.emails/send! :return nil}]
     (let [profile (th/create-profile* 1)
           pool    (:app.db/pool th/*system*)
           data    {::th/type :request-email-change
@@ -312,7 +414,7 @@
       (let [out (th/mutation! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
-        (let [mock (deref email-send-mock)]
+        (let [mock @mock]
           (t/is (= 1 (:call-count mock)))
           (t/is (true? (:called? mock)))))
 
@@ -321,7 +423,7 @@
       (let [out (th/mutation! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
-        (t/is (= 2 (:call-count (deref email-send-mock)))))
+        (t/is (= 2 (:call-count @mock))))
 
       ;; with bounces
       (th/create-global-complaint-for pool {:type :bounce :email (:email data)})
@@ -331,28 +433,26 @@
         (t/is (th/ex-info? error))
         (t/is (th/ex-of-type? error :validation))
         (t/is (th/ex-of-code? error :email-has-permanent-bounces))
-        (t/is (= 2 (:call-count (deref email-send-mock))))))))
+        (t/is (= 2 (:call-count @mock)))))))
 
 
-(t/deftest test-email-change-request-without-smtp
+(t/deftest email-change-request-without-smtp
-  (with-mocks [email-send-mock {:target 'app.emails/send! :return nil}]
+  (with-mocks [mock {:target 'app.emails/send! :return nil}]
     (with-redefs [app.config/flags #{}]
       (let [profile (th/create-profile* 1)
             pool    (:app.db/pool th/*system*)
             data    {::th/type :request-email-change
                      :profile-id (:id profile)
-                     :email "user1@example.com"}]
+                     :email "user1@example.com"}
+            out     (th/mutation! data)]
 
-        (let [out (th/mutation! data)
+        ;; (th/print-result! out)
-              res (:result out)]
+        (t/is (false? (:called? @mock)))
-
+        (let [res (:result out)]
-          ;; (th/print-result! out)
+          (t/is (= {:changed true} res)))))))
-          (t/is (= {:changed true} res))
-          (let [mock (deref email-send-mock)]
-            (t/is (false? (:called? mock)))))))))
 
 
-(t/deftest test-request-profile-recovery
+(t/deftest request-profile-recovery
   (with-mocks [mock {:target 'app.emails/send! :return nil}]
     (let [profile1 (th/create-profile* 1)
           profile2 (th/create-profile* 2 {:is-active true})
@@ -363,13 +463,13 @@
       (let [data (assoc data :email "foo@bar.com")
             out  (th/mutation! data)]
         (t/is (nil? (:result out)))
-        (t/is (= 0 (:call-count (deref mock)))))
+        (t/is (= 0 (:call-count @mock))))
 
       ;; with valid email inactive user
       (let [data  (assoc data :email (:email profile1))
             out   (th/mutation! data)
             error (:error out)]
-        (t/is (= 0 (:call-count (deref mock))))
+        (t/is (= 0 (:call-count @mock)))
         (t/is (th/ex-info? error))
         (t/is (th/ex-of-type? error :validation))
         (t/is (th/ex-of-code? error :profile-not-verified)))
@@ -379,7 +479,7 @@
             out   (th/mutation! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
-        (t/is (= 1 (:call-count (deref mock)))))
+        (t/is (= 1 (:call-count @mock))))
 
       ;; with valid email and active user with global complaints
       (th/create-global-complaint-for pool {:type :complaint :email (:email profile2)})
@@ -387,7 +487,7 @@
             out   (th/mutation! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
-        (t/is (= 2 (:call-count (deref mock)))))
+        (t/is (= 2 (:call-count @mock))))
 
       ;; with valid email and active user with global bounce
       (th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
@@ -395,7 +495,7 @@
             out   (th/mutation! data)
             error (:error out)]
         ;; (th/print-result! out)
-        (t/is (= 2 (:call-count (deref mock))))
+        (t/is (= 2 (:call-count @mock)))
         (t/is (th/ex-info? error))
         (t/is (th/ex-of-type? error :validation))
         (t/is (th/ex-of-code? error :email-has-permanent-bounces)))

backend/test/app/test_helpers.clj

@@ -26,6 +26,7 @@
    [app.util.time :as dt]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
+   [clojure.test :as t]
    [cuerdas.core :as str]
    [datoteka.core :as fs]
    [environ.core :refer [env]]
@@ -299,6 +300,14 @@
   (let [method-fn (get-in *system* [:app.rpc/methods :queries type])]
     (try-on! (method-fn (dissoc data ::type)))))
 
+(defn run-task!
+  ([name]
+   (run-task! name {}))
+  ([name params]
+   (let [tasks (:app.worker/registry *system*)]
+     (let [task-fn (get tasks name)]
+       (task-fn params)))))
+
 ;; --- UTILS
 
 (defn print-error!
@@ -358,6 +367,10 @@
   (let [data (ex-data e)]
     (= code (:code data))))
 
+(defn success?
+  [{:keys [result error]}]
+  (nil? error))
+
 (defn tempfile
   [source]
   (let [rsc (io/resource source)
@@ -366,29 +379,6 @@
              (io/file tmp))
     tmp))
 
-(defn sleep
-  [ms]
-  (Thread/sleep ms))
-
-(defn mock-config-get-with
-  "Helper for mock app.config/get"
-  [data]
-  (fn
-    ([key]
-     (get data key (get cf/config key)))
-    ([key default]
-     (get data key (get cf/config key default)))))
-
-
-(defmacro with-mocks
-  [rebinds & body]
-  `(with-redefs-fn ~rebinds
-     (fn [] ~@body)))
-
-(defn reset-mock!
-  [m]
-  (reset! m @(mk/make-mock {})))
-
 (defn pause
   []
   (let [^java.io.Console cnsl (System/console)]
@@ -408,3 +398,18 @@
   [& params]
   (apply db/query *pool* params))
 
+(defn sleep
+  [ms-or-duration]
+  (Thread/sleep (inst-ms (dt/duration ms-or-duration))))
+
+(defn config-get-mock
+  [data]
+  (fn
+    ([key]
+     (get data key (get cf/config key)))
+    ([key default]
+     (get data key (get cf/config key default)))))
+
+(defn reset-mock!
+  [m]
+  (reset! m @(mk/make-mock {})))

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

@@ -62,33 +62,34 @@
   [{:keys [route] :as props}]
   (let [token (get-in route [:query-params :token])
         bad-token (mf/use-state false)]
-    (mf/use-effect
-     (fn []
-       (dom/set-html-title (tr "title.default"))
-       (->> (rp/mutation :verify-token {:token token})
-            (rx/subs
-             (fn [tdata]
-               (handle-token tdata))
-             (fn [{:keys [type code] :as error}]
-               (cond
-                 (or (= :validation type)
-                      (= :invalid-token code)
-                      (= :token-expired (:reason error)))
-                 (reset! bad-token true)
-                 (= :email-already-exists code)
-                 (let [msg (tr "errors.email-already-exists")]
-                   (ts/schedule 100 #(st/emit! (dm/error msg)))
-                   (st/emit! (rt/nav :auth-login)))
 
-                 (= :email-already-validated code)
+    (mf/with-effect []
-                 (let [msg (tr "errors.email-already-validated")]
+      (dom/set-html-title (tr "title.default"))
-                   (ts/schedule 100 #(st/emit! (dm/warn msg)))
+      (->> (rp/command! :verify-token {:token token})
-                   (st/emit! (rt/nav :auth-login)))
+           (rx/subs
+            (fn [tdata]
+              (handle-token tdata))
+            (fn [{:keys [type code] :as error}]
+              (cond
+                (or (= :validation type)
+                    (= :invalid-token code)
+                    (= :token-expired (:reason error)))
+                (reset! bad-token true)
 
-                 :else
+                (= :email-already-exists code)
-                 (let [msg (tr "errors.generic")]
+                (let [msg (tr "errors.email-already-exists")]
-                   (ts/schedule 100 #(st/emit! (dm/error msg)))
+                  (ts/schedule 100 #(st/emit! (dm/error msg)))
-                   (st/emit! (rt/nav :auth-login)))))))))
+                  (st/emit! (rt/nav :auth-login)))
+
+                (= :email-already-validated code)
+                (let [msg (tr "errors.email-already-validated")]
+                  (ts/schedule 100 #(st/emit! (dm/warn msg)))
+                  (st/emit! (rt/nav :auth-login)))
+
+                :else
+                (let [msg (tr "errors.generic")]
+                  (ts/schedule 100 #(st/emit! (dm/error msg)))
+                  (st/emit! (rt/nav :auth-login))))))))
 
     (if @bad-token
       [:> static/static-header {}