0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-13 16:21:57 -05:00

Allow repeated registers after small delay

Helps users with expired tokens proceed with a new register
This commit is contained in:
Andrey Antukh 2022-09-21 14:20:26 +02:00
parent 395a7096bf
commit 37e2fe5c65
10 changed files with 487 additions and 293 deletions

View file

@ -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

View file

@ -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
[{:keys [pool sprops] :as cfg} params]
(defn validate-register-attempt!
[{: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)
:password (:password params)
:invitation-token (:invitation-token params)
:backend "penpot"
:iss :prepared-register
:exp (dt/in-future "48h")}
(def register-retry-threshold
(dt/duration "15m"))
(defn- elapsed-register-retry-threshold?
[profile]
(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
all the other fields with defaults."
"Create the profile entry on the database with limited set of input
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})
params (merge params claims)]
(check-profile-existence! conn params)
(let [claims (tokens/verify sprops {:token token :iss :prepared-register})
params (merge params claims)]
(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)
(create-profile conn)
(create-profile-relations conn)
(profile/decode-profile-row))
profile (if-let [profile-id (:profile-id claims)]
(profile/retrieve-profile conn profile-id)
(->> (assoc params :is-active is-active)
(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,

View file

@ -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))

View file

@ -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.

View file

@ -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]
[cuerdas.core :as str]))
(defmulti process-token (fn [_ _ claims] (:iss claims)))
[clojure.spec.alpha :as s]))
(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))

View file

@ -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))))))

View file

@ -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 (= :spec-validation (th/ex-code error)))))
(t/is (th/ex-of-type? error :validation))
(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 (= :file-thumbnail-not-found (th/ex-code error)))))
(t/is (th/ex-of-type? error :not-found))
(t/is (th/ex-of-code? error :file-thumbnail-not-found))))
))

View file

@ -119,15 +119,14 @@
))
(t/deftest profile-deletion-simple
(let [task (:app.tasks.objects-gc/handler th/*system*)
prof (th/create-profile* 1)
(let [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)]
(t/is (th/ex-info? error))
(t/is (= :restriction (th/ex-type error)))
(t/is (= :email-does-not-match-invitation (th/ex-code error))))))
out (th/command! data)]
(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"}]
(let [{:keys [result error] :as out} (th/mutation! data)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :restriction))
(t/is (th/ex-of-code? error :registration-disabled))))))
:password "foobar"}
out (th/command! data)]
(t/is (not (th/success? out)))
(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"}]
(let [{:keys [result error] :as out} (th/mutation! 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)))))
:password "foobar"}
out (th/command! data)]
(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)]
(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)))))
(let [out (th/command! data)]
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(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 [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "USER@example.com"}]
(let [out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(let [{:keys [result error] :as out} (th/mutation! data)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :email-as-password)))))
(t/deftest register-profile-with-email-as-password
(let [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "USER@example.com"}
out (th/command! data)]
(t/deftest test-email-change-request
(with-mocks [email-send-mock {:target 'app.emails/send! :return nil}]
(t/is (not (th/success? out)))
(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
(with-mocks [email-send-mock {:target 'app.emails/send! :return nil}]
(t/deftest email-change-request-without-smtp
(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)
res (:result out)]
;; (th/print-result! out)
(t/is (= {:changed true} res))
(let [mock (deref email-send-mock)]
(t/is (false? (:called? mock)))))))))
;; (th/print-result! out)
(t/is (false? (:called? @mock)))
(let [res (:result out)]
(t/is (= {:changed true} res)))))))
(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)))

View file

@ -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 {})))

View file

@ -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)
(let [msg (tr "errors.email-already-validated")]
(ts/schedule 100 #(st/emit! (dm/warn msg)))
(st/emit! (rt/nav :auth-login)))
(mf/with-effect []
(dom/set-html-title (tr "title.default"))
(->> (rp/command! :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)
:else
(let [msg (tr "errors.generic")]
(ts/schedule 100 #(st/emit! (dm/error msg)))
(st/emit! (rt/nav :auth-login)))))))))
(= :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)
(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 {}