3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-22 16:06:11 +02:00
Code Issues Projects Releases Packages Wiki Activity

✨ Improve internal registration flow

Browse source
This commit is contained in:
Andrey Antukh 2024-02-27 17:06:02 +01:00 • committed by Andrés Moya
parent 606aeeb38f
commit ce790d83fd
9 changed files with 428 additions and 358 deletions
Download patch file Download diff file Expand all files Collapse all files

168
backend/src/app/auth/oidc.clj
View file

@ -282,12 +282,12 @@
(into [(keyword (:name provider) fitem)] (map keyword) items))) (into [(keyword (:name provider) fitem)] (map keyword) items)))
(defn- build-redirect-uri (defn- build-redirect-uri
[{:keys [provider] :as cfg}] [{:keys [::provider] :as cfg}]
(let [public (u/uri (cf/get :public-uri))] (let [public (u/uri (cf/get :public-uri))]
(str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback"))))) (str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback")))))
(defn- build-auth-uri (defn- build-auth-uri
[{:keys [provider] :as cfg} state] [{:keys [::provider] :as cfg} state]
(let [params {:client_id (:client-id provider) (let [params {:client_id (:client-id provider)
:redirect_uri (build-redirect-uri cfg) :redirect_uri (build-redirect-uri cfg)
:response_type "code" :response_type "code"
@ -298,15 +298,19 @@
(assoc :query query) (assoc :query query)
(str)))) (str))))
(defn- qualify-prop-key
[provider k]
(keyword (:name provider) (name k)))
(defn- qualify-props (defn- qualify-props
[provider props] [provider props]
(reduce-kv (fn [result k v] (reduce-kv (fn [result k v]
(assoc result (keyword (:name provider) (name k)) v)) (assoc result (qualify-prop-key provider k) v))
{} {}
props)) props))
(defn fetch-access-token (defn- fetch-access-token
[{:keys [provider] :as cfg} code] [{:keys [::provider] :as cfg} code]
(let [params {:client_id (:client-id provider) (let [params {:client_id (:client-id provider)
:client_secret (:client-secret provider) :client_secret (:client-secret provider)
:code code :code code
@ -363,7 +367,7 @@
:props props}))) :props props})))
(defn- fetch-user-info (defn- fetch-user-info
[{:keys [provider] :as cfg} tdata] [{:keys [::provider] :as cfg} tdata]
(l/trace :hint "fetch user info" (l/trace :hint "fetch user info"
:uri (:user-uri provider) :uri (:user-uri provider)
:token (obfuscate-string (:token/access tdata))) :token (obfuscate-string (:token/access tdata)))
@ -388,7 +392,7 @@
(-> response :body json/decode))) (-> response :body json/decode)))
(defn- get-user-info (defn- get-user-info
[{:keys [provider]} tdata] [{:keys [::provider]} tdata]
(try (try
(when (:token/id tdata) (when (:token/id tdata)
(let [{:keys [kid alg] :as theader} (jwt/decode-header (:token/id tdata))] (let [{:keys [kid alg] :as theader} (jwt/decode-header (:token/id tdata))]
@ -412,8 +416,8 @@
::fullname ::fullname
::props])) ::props]))
(defn get-info (defn- get-info
[{:keys [provider ::setup/props] :as cfg} {:keys [params] :as request}] [{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
(when-let [error (get params :error)] (when-let [error (get params :error)]
(ex/raise :type :internal (ex/raise :type :internal
:code :error-on-retrieving-code :code :error-on-retrieving-code
@ -471,89 +475,101 @@
(update :props merge (:props state))))) (update :props merge (:props state)))))
(defn- get-profile (defn- get-profile
[{:keys [::db/pool] :as cfg} info] [cfg info]
(dm/with-open [conn (db/open pool)] (db/run! cfg (fn [{:keys [::db/conn]}]
(some->> (:email info) (some->> (:email info)
(profile/clean-email) (profile/clean-email)
(profile/get-profile-by-email conn)))) (profile/get-profile-by-email conn)))))
(defn- redirect-response (defn- redirect-response
[uri] [uri]
{::rres/status 302 {::rres/status 302
::rres/headers {"location" (str uri)}}) ::rres/headers {"location" (str uri)}})
(defn- generate-error-redirect (defn- redirect-with-error
[_ cause] ([error] (redirect-with-error error nil))
(let [data (if (ex/error? cause) (ex-data cause) nil) ([error hint]
code (or (:code data) :unexpected) (let [params {:error error :hint hint}
type (or (:type data) :internal) params (d/without-nils params)
hint (or (:hint data) uri (-> (u/uri (cf/get :public-uri))
(if (ex/exception? cause) (assoc :path "/#/auth/login")
(ex-message cause) (assoc :query (u/map->query-string params)))]
(str cause))) (redirect-response uri))))
params {:error "unable-to-auth" (defn- redirect-to-register
:hint hint [cfg info]
:type type (let [info (assoc info
:code code} :iss :prepared-register
:exp (dt/in-future {:hours 48}))
params {:token (tokens/generate (::setup/props cfg) info)
:fullname (:fullname info)}
params (d/without-nils params)]
(redirect-response
(-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/register/validate")
(assoc :query (u/map->query-string params))))))
(defn- redirect-to-verify-token
[token]
(let [params {:token token}
uri (-> (u/uri (cf/get :public-uri)) uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/login") (assoc :path "/#/auth/verify-token")
(assoc :query (u/map->query-string params)))] (assoc :query (u/map->query-string params)))]
(redirect-response uri))) (redirect-response uri)))
(defn- generate-redirect (defn- provider-matches-profile?
[{:keys [::provider] :as cfg} {:keys [props] :as profile}]
(or (= (:auth-backend profile) (:name provider))
(let [email-prop (qualify-prop-key provider :email)]
(contains? props email-prop))))
(defn- provider-has-email-verified?
[{:keys [::provider] :as cfg} {:keys [props] :as info}]
(let [prop (qualify-prop-key provider :email_verified)]
(true? (get props prop))))
(defn- process-callback
[cfg request info profile] [cfg request info profile]
(if profile (cond
(let [sxf (session/create-fn cfg (:id profile)) (some? profile)
token (or (:invitation-token info) (cond
(tokens/generate (::setup/props cfg) (:is-blocked profile)
{:iss :auth (redirect-with-error "profile-blocked")
:exp (dt/in-future "15m")
:profile-id (:id profile)}))
params {:token token}
uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/verify-token")
(assoc :query (u/map->query-string params)))]
(when (:is-blocked profile) (not (provider-matches-profile? cfg profile))
(ex/raise :type :restriction (redirect-with-error "auth-provider-not-allowed")
:code :profile-blocked))
(audit/submit! cfg {::audit/type "command" (not (:is-active profile))
::audit/name "login-with-oidc" (let [info (assoc info :profile-id (:id profile))]
::audit/profile-id (:id profile) (redirect-to-register cfg info))
::audit/ip-addr (audit/parse-client-ip request)
::audit/props (audit/profile->props profile)})
(->> (redirect-response uri) :else
(sxf request))) (let [sxf (session/create-fn cfg (:id profile))
token (or (:invitation-token info)
(tokens/generate (::setup/props cfg)
{:iss :auth
:exp (dt/in-future "15m")
:props (:props info)
:profile-id (:id profile)}))]
(if (auth/email-domain-in-whitelist? (:email info)) (audit/submit! cfg {::audit/type "command"
(let [info (assoc info ::audit/name "login-with-oidc"
:iss :prepared-register ::audit/profile-id (:id profile)
:exp (dt/in-future {:hours 48})) ::audit/ip-addr (audit/parse-client-ip request)
::audit/props (audit/profile->props profile)})
props (:props info) (->> (redirect-to-verify-token token)
info (if (or (:google/email_verified props) (sxf request))))
(:github/email_verified props)
(:gitlab/email_verified props)
(:oidc/email_verified props))
(assoc info :is-active true)
info)
token (tokens/generate (::setup/props cfg) info) (not (auth/email-domain-in-whitelist? (:email info)))
(redirect-with-error "email-domain-not-allowed")
params (d/without-nils :else
{:token token (let [info (assoc info :is-active (provider-has-email-verified? cfg info))]
:fullname (:fullname info)}) (redirect-to-register cfg info))))
uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/register/validate")
(assoc :query (u/map->query-string params)))]
(redirect-response uri))
(generate-error-redirect cfg "email-domain-not-allowed"))))
(defn- auth-handler (defn- auth-handler
[cfg {:keys [params] :as request}] [cfg {:keys [params] :as request}]
@ -572,10 +588,10 @@
(try (try
(let [info (get-info cfg request) (let [info (get-info cfg request)
profile (get-profile cfg info)] profile (get-profile cfg info)]
(generate-redirect cfg request info profile)) (process-callback cfg request info profile))
(catch Throwable cause (catch Throwable cause
(l/warn :hint "error on oauth process" :cause cause) (l/err :hint "error on oauth process" :cause cause)
(generate-error-redirect cfg cause)))) (redirect-with-error "unable-to-auth" (ex-message cause)))))
(def provider-lookup (def provider-lookup
{:compile {:compile
@ -584,13 +600,12 @@
(fn [request] (fn [request]
(let [provider (some-> request :path-params :provider keyword)] (let [provider (some-> request :path-params :provider keyword)]
(if-let [provider (get providers provider)] (if-let [provider (get providers provider)]
(handler (assoc cfg :provider provider) request) (handler (assoc cfg ::provider provider) request)
(ex/raise :type :restriction (ex/raise :type :restriction
:code :provider-not-configured :code :provider-not-configured
:provider provider :provider provider
:hint "provider not configured"))))))}) :hint "provider not configured"))))))})
(s/def ::client-id ::cf/oidc-client-id) (s/def ::client-id ::cf/oidc-client-id)
(s/def ::client-secret ::cf/oidc-client-secret) (s/def ::client-secret ::cf/oidc-client-secret)
(s/def ::base-uri ::cf/oidc-base-uri) (s/def ::base-uri ::cf/oidc-base-uri)
@ -603,7 +618,6 @@
(s/def ::email-attr ::cf/oidc-email-attr) (s/def ::email-attr ::cf/oidc-email-attr)
(s/def ::name-attr ::cf/oidc-name-attr) (s/def ::name-attr ::cf/oidc-name-attr)
;; FIXME: migrate to qualified-keywords
(s/def ::provider (s/def ::provider
(s/keys :req-un [::client-id (s/keys :req-un [::client-id
::client-secret] ::client-secret]

89
backend/src/app/http/debug.clj
View file

@ -16,7 +16,6 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.main :as-alias main]
[app.rpc.commands.auth :as auth] [app.rpc.commands.auth :as auth]
[app.rpc.commands.files-create :refer [create-file]] [app.rpc.commands.files-create :refer [create-file]]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
@ -341,57 +340,57 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- resend-email-notification (defn- resend-email-notification
[{:keys [::db/pool ::setup/props] :as cfg} {:keys [params] :as request}] [cfg {:keys [params] :as request}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(when-not (contains? params :force)
(ex/raise :type :validation
:code :missing-force
:hint "missing force checkbox"))
(when-not (contains? params :force) (let [profile (some->> params
(ex/raise :type :validation :email
:code :missing-force (profile/clean-email)
:hint "missing force checkbox")) (profile/get-profile-by-email conn))]
(let [profile (some->> params (when-not profile
:email (ex/raise :type :validation
(profile/clean-email) :code :missing-profile
(profile/get-profile-by-email pool))] :hint "unable to find profile by email"))
(when-not profile (cond
(ex/raise :type :validation (contains? params :block)
:code :missing-profile (do
:hint "unable to find profile by email")) (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
(db/delete! conn :http-session {:profile-id (:id profile)})
(cond {::rres/status 200
(contains? params :block) ::rres/headers {"content-type" "text/plain"}
(do ::rres/body (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
(db/update! pool :profile {:is-blocked true} {:id (:id profile)})
(db/delete! pool :http-session {:profile-id (:id profile)})
{::rres/status 200 (contains? params :unblock)
::rres/headers {"content-type" "text/plain"} (do
::rres/body (str/ffmt "PROFILE '%' BLOCKED" (:email profile))}) (db/update! conn :profile {:is-blocked false} {:id (:id profile)})
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "PROFILE '%' UNBLOCKED" (:email profile))})
(contains? params :unblock) (contains? params :resend)
(do (if (:is-blocked profile)
(db/update! pool :profile {:is-blocked false} {:id (:id profile)}) {::rres/status 200
{::rres/status 200 ::rres/headers {"content-type" "text/plain"}
::rres/headers {"content-type" "text/plain"} ::rres/body "PROFILE ALREADY BLOCKED"}
::rres/body (str/ffmt "PROFILE '%' UNBLOCKED" (:email profile))}) (do
(#'auth/send-email-verification! cfg profile)
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "RESENDED FOR '%'" (:email profile))}))
(contains? params :resend) :else
(if (:is-blocked profile) (do
{::rres/status 200 (db/update! conn :profile {:is-active true} {:id (:id profile)})
::rres/headers {"content-type" "text/plain"} {::rres/status 200
::rres/body "PROFILE ALREADY BLOCKED"} ::rres/headers {"content-type" "text/plain"}
(do ::rres/body (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))))
(auth/send-email-verification! pool props profile)
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "RESENDED FOR '%'" (:email profile))}))
:else
(do
(db/update! pool :profile {:is-active true} {:id (:id profile)})
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))
(defn- reset-file-version (defn- reset-file-version

225
backend/src/app/rpc/commands/auth.clj
View file

@ -19,7 +19,6 @@
[app.email :as eml] [app.email :as eml]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit] [app.rpc.climit :as-alias climit]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
@ -38,6 +37,14 @@
(def schema:token (def schema:token
[::sm/word-string {:max 6000}]) [::sm/word-string {:max 6000}])
(def ^:private default-verify-threshold
(dt/duration "15m"))
(defn- elapsed-verify-threshold?
[profile]
(let [elapsed (dt/diff (:modified-at profile) (dt/now))]
(pos? (compare elapsed default-verify-threshold))))
;; ---- COMMAND: login with password ;; ---- COMMAND: login with password
(defn login-with-password (defn login-with-password
@ -139,7 +146,7 @@
(update-password [conn profile-id] (update-password [conn profile-id]
(let [pwd (profile/derive-password cfg password)] (let [pwd (profile/derive-password cfg password)]
(db/update! conn :profile {:password pwd} {:id profile-id}) (db/update! conn :profile {:password pwd :is-active true} {:id profile-id})
nil))] nil))]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
@ -162,8 +169,8 @@
;; ---- COMMAND: Prepare Register ;; ---- COMMAND: Prepare Register
(defn validate-register-attempt! (defn- validate-register-attempt!
[{:keys [::db/pool] :as cfg} params] [cfg params]
(when-not (contains? cf/flags :registration) (when-not (contains? cf/flags :registration)
(when-not (contains? params :invitation-token) (when-not (contains? params :invitation-token)
@ -171,7 +178,9 @@
:code :registration-disabled))) :code :registration-disabled)))
(when (contains? params :invitation-token) (when (contains? params :invitation-token)
(let [invitation (tokens/verify (::setup/props cfg) {:token (:invitation-token params) :iss :team-invitation})] (let [invitation (tokens/verify (::setup/props cfg)
{:token (:invitation-token params)
:iss :team-invitation})]
(when-not (= (:email params) (:member-email invitation)) (when-not (= (:email params) (:member-email invitation))
(ex/raise :type :restriction (ex/raise :type :restriction
:code :email-does-not-match-invitation :code :email-does-not-match-invitation
@ -181,13 +190,6 @@
(ex/raise :type :validation (ex/raise :type :validation
:code :email-domain-is-not-allowed)) :code :email-domain-is-not-allowed))
;; Don't allow proceed in preparing registration if the profile is
;; already reported as spammer.
(when (eml/has-bounce-reports? pool (:email params))
(ex/raise :type :validation
:code :email-has-permanent-bounces
:hint "looks like the email has one or many bounces reported"))
;; Perform a basic validation of email & password ;; Perform a basic validation of email & password
(when (= (str/lower (:email params)) (when (= (str/lower (:email params))
(str/lower (:password params))) (str/lower (:password params)))
@ -195,35 +197,13 @@
:code :email-as-password :code :email-as-password
:hint "you can't use your email as password"))) :hint "you can't use your email as password")))
(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 (defn prepare-register
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}] [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
(validate-register-attempt! cfg params) (validate-register-attempt! cfg params)
(let [email (profile/clean-email email) (let [email (profile/clean-email email)
profile (when-let [profile (profile/get-profile-by-email pool email)] profile (profile/get-profile-by-email pool email)
(cond
(:is-blocked profile)
(ex/raise :type :restriction
:code :profile-blocked)
(and (not (:is-active profile))
(elapsed-register-retry-threshold? profile))
profile
:else
(ex/raise :type :validation
:code :email-already-exists
:hint "profile already exists")))
params {:email email params {:email email
:password (:password params) :password (:password params)
:invitation-token (:invitation-token params) :invitation-token (:invitation-token params)
@ -233,7 +213,6 @@
:exp (dt/in-future {:days 7})} :exp (dt/in-future {:days 7})}
params (d/without-nils params) params (d/without-nils params)
token (tokens/generate (::setup/props cfg) params)] token (tokens/generate (::setup/props cfg) params)]
(with-meta {:token token} (with-meta {:token token}
{::audit/profile-id uuid/zero}))) {::audit/profile-id uuid/zero})))
@ -317,17 +296,16 @@
{::db/return-keys true}) {::db/return-keys true})
(profile/decode-row)))) (profile/decode-row))))
(defn send-email-verification! (defn send-email-verification!
[conn props profile] [{:keys [::db/conn] :as cfg} profile]
(let [vtoken (tokens/generate props (let [vtoken (tokens/generate (::setup/props cfg)
{:iss :verify-email {:iss :verify-email
:exp (dt/in-future "72h") :exp (dt/in-future "72h")
:profile-id (:id profile) :profile-id (:id profile)
:email (:email profile)}) :email (:email profile)})
;; NOTE: this token is mainly used for possible complains ;; NOTE: this token is mainly used for possible complains
;; identification on the sns webhook ;; identification on the sns webhook
ptoken (tokens/generate props ptoken (tokens/generate (::setup/props cfg)
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile) :profile-id (:id profile)
:exp (dt/in-future {:days 30})})] :exp (dt/in-future {:days 30})})]
@ -346,69 +324,94 @@
(into params) (into params)
(assoc :fullname fullname)) (assoc :fullname fullname))
is-active (or (:is-active params)
(not (contains? cf/flags :email-verification)))
profile (if-let [profile-id (:profile-id claims)] profile (if-let [profile-id (:profile-id claims)]
(profile/get-profile conn profile-id) (profile/get-profile conn profile-id)
(let [params (-> params (let [is-active (or (boolean (:is-active params))
(assoc :is-active is-active) (not (contains? cf/flags :email-verification)))
(update :password #(profile/derive-password cfg %)))] params (-> params
(assoc :is-active is-active)
(update :password #(profile/derive-password cfg %)))]
(->> (create-profile! conn params) (->> (create-profile! conn params)
(create-profile-rels! conn)))) (create-profile-rels! conn))))
invitation (when-let [token (:invitation-token params)] invitation (when-let [token (:invitation-token params)]
(tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))] (tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
props (audit/profile->props profile)]
;; 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/submit! cfg
{::audit/type "fact"
::audit/name "register-profile-retry"
::audit/profile-id id}))
(cond (cond
;; If invitation token comes in params, this is because the ;; When profile is blocked, we just ignore it and return plain data
;; user comes from team-invitation process; in this case, (:is-blocked profile)
;; regenerate token and send back to the user a new invitation (do
;; token (and mark current session as logged). This happens (l/wrn :hint "register attempt for already blocked profile"
;; only if the invitation email matches with the register :profile-id (str (:id profile))
;; email. :profile-email (:email profile))
(and (some? invitation) (= (:email profile) (:member-email invitation))) (rph/with-meta {:email (:email profile)}
{::audit/replace-props props
::audit/context {:action "ignore-because-blocked"}
::audit/profile-id (:id profile)
::audit/name "register-profile-retry"}))
;; If invitation token comes in params, this is because the user
;; comes from team-invitation process; in this case, regenerate
;; token and send back to the user a new invitation token (and
;; mark current session as logged). This happens only if the
;; invitation email matches with the register email.
(and (some? invitation)
(= (:email profile)
(:member-email invitation)))
(let [claims (assoc invitation :member-id (:id profile)) (let [claims (assoc invitation :member-id (:id profile))
token (tokens/generate (::setup/props cfg) claims) token (tokens/generate (::setup/props cfg) claims)]
resp {:invitation-token token}] (-> {:invitation-token token}
(-> resp
(rph/with-transform (session/create-fn cfg (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props props
::audit/context {:action "accept-invitation"}
::audit/profile-id (:id profile)}))) ::audit/profile-id (:id profile)})))
;; If auth backend is different from "penpot" means user is ;; When a new user is created and it is already activated by
;; registering using third party auth mechanism; in this case ;; configuration or specified by OIDC, we just mark the profile
;; we need to mark this session as logged. ;; as logged-in
(not= "penpot" (:auth-backend profile)) (not (:profile-id claims))
(-> (profile/strip-private-attrs profile) (if (:is-active claims)
(rph/with-transform (session/create-fn cfg (:id profile))) (-> (profile/strip-private-attrs profile)
(rph/with-meta {::audit/replace-props (audit/profile->props profile) (rph/with-transform (session/create-fn cfg (:id profile)))
::audit/profile-id (:id profile)})) (rph/with-meta
{::audit/replace-props props
::audit/context {:action "login"}
::audit/profile-id (:id profile)}))
;; If the `:enable-insecure-register` flag is set, we proceed (do
;; to sign in the user directly, without email verification. (send-email-verification! cfg profile)
(true? is-active) (rph/with-meta {:email (:email profile)}
(-> (profile/strip-private-attrs profile) {::audit/replace-props props
(rph/with-transform (session/create-fn cfg (:id profile))) ::audit/context {:action "email-verification"}
(rph/with-meta {::audit/replace-props (audit/profile->props profile) ::audit/profile-id (:id profile)})))
::audit/profile-id (:id profile)}))
;; In all other cases, send a verification email.
:else :else
(do (let [elapsed? (elapsed-verify-threshold? profile)
(send-email-verification! conn (::setup/props cfg) profile) bounce? (eml/has-bounce-reports? conn (:email profile))
(rph/with-meta profile action (if bounce?
"ignore-because-bounce"
(if elapsed?
"resend-email-verification"
"ignore"))]
(l/wrn :hint "repeated registry detected"
:profile-id (str (:id profile))
:profile-email (:email profile)
:context-action action)
(when (= action "resend-email-verification")
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(send-email-verification! cfg profile))
(rph/with-meta {:email (:email profile)}
{::audit/replace-props (audit/profile->props profile) {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}))))) ::audit/context {:action action}
::audit/profile-id (:id profile)
::audit/name "register-profile-retry"})))))
(def schema:register-profile (def schema:register-profile
[:map {:title "register-profile"} [:map {:title "register-profile"}
@ -427,7 +430,7 @@
;; ---- COMMAND: Request Profile Recovery ;; ---- COMMAND: Request Profile Recovery
(defn request-profile-recovery (defn- request-profile-recovery
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}] [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
(letfn [(create-recovery-token [{:keys [id] :as profile}] (letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (::setup/props cfg) (let [token (tokens/generate (::setup/props cfg)
@ -451,26 +454,38 @@
nil))] nil))]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(when-let [profile (->> (profile/clean-email email) (let [profile (->> (profile/clean-email email)
(profile/get-profile-by-email conn))] (profile/get-profile-by-email conn))]
(when-not (eml/allow-send-emails? conn profile)
(ex/raise :type :validation
:code :profile-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when-not (:is-active profile) (cond
(ex/raise :type :validation (not profile)
:code :profile-not-verified (l/wrn :hint "attempt of profile recovery: no profile found"
:hint "the user need to validate profile before recover password")) :profile-email email)
(when (eml/has-bounce-reports? conn (:email profile)) (not (eml/allow-send-emails? conn profile))
(ex/raise :type :validation (l/wrn :hint "attempt of profile recovery: profile is muted"
:code :email-has-permanent-bounces :profile-id (str (:id profile))
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce")) :profile-email (:email profile))
(->> profile (eml/has-bounce-reports? conn (:email profile))
(create-recovery-token) (l/wrn :hint "attempt of profile recovery: email has bounces"
(send-email-notification conn)))))) :profile-id (str (:id profile))
:profile-email (:email profile))
(not (elapsed-verify-threshold? profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
:profile-id (str (:id profile))
:profile-email (:email profile))
:else
(do
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(->> profile
(create-recovery-token)
(send-email-notification conn))))))))
(def schema:request-profile-recovery (def schema:request-profile-recovery

4
backend/src/app/rpc/commands/profile.clj
View file

@ -91,8 +91,8 @@
(defn get-profile (defn get-profile
"Get profile by id. Throws not-found exception if no profile found." "Get profile by id. Throws not-found exception if no profile found."
[conn id & {:as attrs}] [conn id & {:as opts}]
(-> (db/get-by-id conn :profile id attrs) (-> (db/get-by-id conn :profile id opts)
(decode-row))) (decode-row)))
;; --- MUTATION: Update Profile (own) ;; --- MUTATION: Update Profile (own)

12
backend/src/app/rpc/commands/verify_token.clj
View file

@ -9,6 +9,7 @@
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.db.sql :as-alias sql]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main] [app.main :as-alias main]
@ -82,7 +83,16 @@
(defmethod process-token :auth (defmethod process-token :auth
[{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}] [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
(let [profile (profile/get-profile conn profile-id)] (let [profile (profile/get-profile conn profile-id {::sql/for-update true})
props (merge (:props profile)
(:props claims))
profile (assoc profile :props props)]
(when (not= props (:props profile))
(db/update! conn :profile
{:props (db/tjson props)}
{:id profile-id}))
(assoc claims :profile profile))) (assoc claims :profile profile)))
;; --- Team Invitation ;; --- Team Invitation

12
backend/src/app/srepl/main.clj
View file

@ -86,13 +86,11 @@
(defn resend-email-verification-email! (defn resend-email-verification-email!
[email] [email]
(let [sprops (:app.setup/props main/system) (db/tx-run! main/system
pool (:app.db/pool main/system) (fn [{:keys [::db/conn] :as cfg}]
email (profile/clean-email email) (let [email (profile/clean-email email)
profile (profile/get-profile-by-email pool email)] profile (profile/get-profile-by-email conn email)]
(#'auth/send-email-verification! cfg profile)))))
(auth/send-email-verification! pool sprops profile)
:email-sent))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROFILES MANAGEMENT ;; PROFILES MANAGEMENT

201
backend/test/backend_tests/rpc_profile_test.clj
View file

@ -229,20 +229,51 @@
(t/is (= "mtma" (:penpot/mtm-campaign props))))))) (t/is (= "mtma" (:penpot/mtm-campaign props)))))))
(t/deftest prepare-register-and-register-profile-2 (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.email/send! :return nil}]
(with-mocks [mock {:target 'app.email/send! :return nil}] (let [current-token (atom 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 (th/success? out))
(reset! current-token token))
;; PREPARE REGISTER ;; DO REGISTRATION
(let [data {::th/type :prepare-register-profile (let [data {::th/type :register-profile
:email "hello@example.com" :token @current-token
:password "foobar"} :fullname "foobar"
out (th/command! data) :accept-terms-and-privacy true
token (get-in out [:result :token])] :accept-newsletter-subscription true}
(t/is (string? token)) out (th/command! data)]
(reset! current-token token)) (t/is (nil? (:error out)))
(t/is (= 1 (:call-count @mock))))
;; DO REGISTRATION: try correct register attempt 1 (th/reset-mock! mock)
;; PREPARE REGISTER: second attempt
(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 (th/success? out))
(reset! current-token token))
;; DO REGISTRATION: second attempt
(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 (= 0 (:call-count @mock))))
(with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
:return true}]
;; DO REGISTRATION: third attempt
(let [data {::th/type :register-profile (let [data {::th/type :register-profile
:token @current-token :token @current-token
:fullname "foobar" :fullname "foobar"
@ -250,44 +281,56 @@
:accept-newsletter-subscription true} :accept-newsletter-subscription true}
out (th/command! data)] out (th/command! data)]
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= 1 (:call-count @mock)))) (t/is (= 1 (:call-count @mock))))))))
(th/reset-mock! mock) (t/deftest prepare-register-and-register-profile-3
(with-mocks [mock {:target 'app.email/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 (th/success? out))
(reset! current-token token))
;; PREPARE REGISTER without waiting for threshold ;; DO REGISTRATION
(let [data {::th/type :prepare-register-profile (let [data {::th/type :register-profile
:email "hello@example.com" :token @current-token
:password "foobar"} :fullname "foobar"
out (th/command! data)] :accept-terms-and-privacy true
(t/is (not (th/success? out))) :accept-newsletter-subscription true}
(t/is (= :validation (-> out :error th/ex-type))) out (th/command! data)]
(t/is (= :email-already-exists (-> out :error th/ex-code)))) (t/is (nil? (:error out)))
(t/is (= 1 (:call-count @mock))))
(th/sleep {:millis 500}) (th/reset-mock! mock)
(th/reset-mock! mock)
;; PREPARE REGISTER waiting the threshold (th/db-update! :profile
(let [data {::th/type :prepare-register-profile {:is-blocked true}
:email "hello@example.com" {:email "hello@example.com"})
:password "foobar"}
out (th/command! data)]
(t/is (th/success? out)) ;; PREPARE REGISTER: second attempt
(t/is (= 0 (:call-count @mock))) (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 (th/success? out))
(reset! current-token token))
(let [result (:result out)] (with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
(t/is (contains? result :token)) :return true}]
(reset! current-token (:token result)))) ;; DO REGISTRATION: second attempt
;; DO REGISTRATION: try correct register attempt 1
(let [data {::th/type :register-profile (let [data {::th/type :register-profile
:token @current-token :token @current-token
:fullname "foobar" :fullname "foobar"
:accept-terms-and-privacy true :accept-terms-and-privacy true
:accept-newsletter-subscription true} :accept-newsletter-subscription true}
out (th/command! data)] out (th/command! data)]
(t/is (th/success? out)) (t/is (nil? (:error out)))
(t/is (= 1 (:call-count @mock)))))))) (t/is (= 0 (:call-count @mock))))))))
(t/deftest prepare-and-register-with-invitation-and-disabled-registration-1 (t/deftest prepare-and-register-with-invitation-and-disabled-registration-1
@ -359,13 +402,13 @@
:email (:email profile) :email (:email profile)
:password "foobar"} :password "foobar"}
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token)))))
(t/is (not (th/success? out))) (t/deftest prepare-register-profile-with-bounced-email
(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*) (let [pool (:app.db/pool th/*system*)
data {::th/type :prepare-register-profile data {::th/type :prepare-register-profile
:email "user@example.com" :email "user@example.com"
@ -374,10 +417,9 @@
(th/create-global-complaint-for pool {:type :bounce :email "user@example.com"}) (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
(let [out (th/command! data)] (let [out (th/command! data)]
(t/is (not (th/success? out))) (t/is (th/success? out))
(let [edata (-> out :error ex-data)] (let [result (:result out)]
(t/is (= :validation (:type edata))) (t/is (contains? result :token))))))
(t/is (= :email-has-permanent-bounces (:code edata)))))))
(t/deftest register-profile-with-complained-email (t/deftest register-profile-with-complained-email
(let [pool (:app.db/pool th/*system*) (let [pool (:app.db/pool th/*system*)
@ -455,7 +497,7 @@
(t/deftest request-profile-recovery (t/deftest request-profile-recovery
(with-mocks [mock {:target 'app.email/send! :return nil}] (with-mocks [mock {:target 'app.email/send! :return nil}]
(let [profile1 (th/create-profile* 1) (let [profile1 (th/create-profile* 1 {:is-active false})
profile2 (th/create-profile* 2 {:is-active true}) profile2 (th/create-profile* 2 {:is-active true})
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
data {::th/type :request-profile-recovery}] data {::th/type :request-profile-recovery}]
@ -468,38 +510,47 @@
;; with valid email inactive user ;; with valid email inactive user
(let [data (assoc data :email (:email profile1)) (let [data (assoc data :email (:email profile1))
out (th/command! data) out (th/command! data)]
error (:error out)]
(t/is (= 0 (:call-count @mock))) (t/is (= 0 (:call-count @mock)))
(t/is (th/ex-info? error)) (t/is (nil? (:result out)))
(t/is (th/ex-of-type? error :validation)) (t/is (nil? (:error out))))
(t/is (th/ex-of-code? error :profile-not-verified)))
(with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
:return true}]
;; with valid email inactive user
(let [data (assoc data :email (:email profile1))
out (th/command! data)]
(t/is (= 1 (:call-count @mock)))
(t/is (nil? (:result out)))
(t/is (nil? (:error out)))))
(th/reset-mock! mock)
;; with valid email and active user ;; with valid email and active user
(let [data (assoc data :email (:email profile2)) (with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
out (th/command! data)] :return true}]
;; (th/print-result! out) (let [data (assoc data :email (:email profile2))
(t/is (nil? (:result out))) out (th/command! data)]
(t/is (= 1 (:call-count @mock)))) ;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 1 (:call-count @mock))))
;; with valid email and active user with global complaints ;; with valid email and active user with global complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email profile2)}) (th/create-global-complaint-for pool {:type :complaint :email (:email profile2)})
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:result out))) (t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock)))) (t/is (= 2 (:call-count @mock))))
;; with valid email and active user with global bounce ;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)}) (th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/command! data) out (th/command! data)]
error (:error out)] (t/is (nil? (:result out)))
;; (th/print-result! out) (t/is (nil? (:error out)))
(t/is (= 2 (:call-count @mock))) ;; (th/print-result! out)
(t/is (th/ex-info? error)) (t/is (= 2 (:call-count @mock))))))))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :email-has-permanent-bounces))))))
(t/deftest update-profile-password (t/deftest update-profile-password

4
frontend/src/app/main/ui/auth/login.cljs
View file

@ -107,8 +107,8 @@
:initial initial) :initial initial)
on-error on-error
(fn [err] (fn [cause]
(let [cause (ex-data err)] (let [cause (ex-data cause)]
(cond (cond
(and (= :restriction (:type cause)) (and (= :restriction (:type cause))
(= :profile-blocked (:code cause))) (= :profile-blocked (:code cause)))

71
frontend/src/app/main/ui/auth/register.cljs
View file

@ -26,18 +26,20 @@
;; --- PAGE: Register ;; --- PAGE: Register
(defn- validate (defn- validate-password-length
[errors data] [errors data]
(let [password (:password data)] (let [password (:password data)]
(cond-> errors (cond-> errors
(> 8 (count password)) (> 8 (count password))
(assoc :password {:message "errors.password-too-short"}) (assoc :password {:message "errors.password-too-short"}))))
:always
(d/update-when :email (defn- validate-email
(fn [{:keys [code] :as error}] [errors _]
(cond-> error (d/update-when errors :email
(= code ::us/email) (fn [{:keys [code] :as error}]
(assoc :message (tr "errors.email-invalid")))))))) (cond-> error
(= code ::us/email)
(assoc :message (tr "errors.email-invalid"))))))
(s/def ::fullname ::us/not-empty-string) (s/def ::fullname ::us/not-empty-string)
(s/def ::password ::us/not-empty-string) (s/def ::password ::us/not-empty-string)
@ -49,31 +51,20 @@
(s/keys :req-un [::password ::email] (s/keys :req-un [::password ::email]
:opt-un [::invitation-token])) :opt-un [::invitation-token]))
(defn- handle-prepare-register-error (defn- on-prepare-register-error
[form cause] [form cause]
(let [{:keys [type code]} (ex-data cause)] (let [{:keys [type code]} (ex-data cause)]
(condp = [type code] (condp = [type code]
[:restriction :registration-disabled] [:restriction :registration-disabled]
(st/emit! (msg/error (tr "errors.registration-disabled"))) (st/emit! (msg/error (tr "errors.registration-disabled")))
[:restriction :profile-blocked]
(st/emit! (msg/error (tr "errors.profile-blocked")))
[:validation :email-has-permanent-bounces]
(let [email (get @form [:data :email])]
(st/emit! (msg/error (tr "errors.email-has-permanent-bounces" email))))
[:validation :email-already-exists]
(swap! form assoc-in [:errors :email]
{:message "errors.email-already-exists"})
[:validation :email-as-password] [:validation :email-as-password]
(swap! form assoc-in [:errors :password] (swap! form assoc-in [:errors :password]
{:message "errors.email-as-password"}) {:message "errors.email-as-password"})
(st/emit! (msg/error (tr "errors.generic")))))) (st/emit! (msg/error (tr "errors.generic"))))))
(defn- handle-prepare-register-success (defn- on-prepare-register-success
[params] [params]
(st/emit! (rt/nav :auth-register-validate {} params))) (st/emit! (rt/nav :auth-register-validate {} params)))
@ -81,28 +72,30 @@
[{:keys [params on-success-callback]}] [{:keys [params on-success-callback]}]
(let [initial (mf/use-memo (mf/deps params) (constantly params)) (let [initial (mf/use-memo (mf/deps params) (constantly params))
form (fm/use-form :spec ::register-form form (fm/use-form :spec ::register-form
:validators [validate :validators [validate-password-length
validate-email
(fm/validate-not-empty :password (tr "auth.password-not-empty"))] (fm/validate-not-empty :password (tr "auth.password-not-empty"))]
:initial initial) :initial initial)
submitted? (mf/use-state false)
on-success (fn [p] submitted? (mf/use-state false)
(if (nil? on-success-callback)
(handle-prepare-register-success p)
(on-success-callback p)))
on-submit on-submit
(mf/use-fn (mf/use-fn
(mf/deps on-success-callback)
(fn [form _event] (fn [form _event]
(reset! submitted? true) (reset! submitted? true)
(let [cdata (:clean-data @form)] (let [cdata (:clean-data @form)
on-success (fn [data]
(if (nil? on-success-callback)
(on-prepare-register-success data)
(on-success-callback data)))
on-error (fn [data]
(on-prepare-register-error form data))]
(->> (rp/cmd! :prepare-register-profile cdata) (->> (rp/cmd! :prepare-register-profile cdata)
(rx/map #(merge % params)) (rx/map #(merge % params))
(rx/finalize #(reset! submitted? false)) (rx/finalize #(reset! submitted? false))
(rx/subs! (rx/subs! on-success on-error)))))]
on-success
(partial handle-prepare-register-error form))))))]
[:& fm/form {:on-submit on-submit :form form} [:& fm/form {:on-submit on-submit :form form}
[:div {:class (stl/css :fields-row)} [:div {:class (stl/css :fields-row)}
@ -126,7 +119,6 @@
:data-test "register-form-submit" :data-test "register-form-submit"
:class (stl/css :register-btn)}]])) :class (stl/css :register-btn)}]]))
(mf/defc register-methods (mf/defc register-methods
{::mf/props :obj} {::mf/props :obj}
[{:keys [params on-success-callback]}] [{:keys [params on-success-callback]}]
@ -169,15 +161,8 @@
;; --- PAGE: register validation ;; --- PAGE: register validation
(defn- handle-register-error (defn- handle-register-error
[form error] [_form _data]
(case (:code error) (st/emit! (msg/error (tr "errors.generic"))))
:email-already-exists
(swap! form assoc-in [:errors :email]
{:message "errors.email-already-exists"})
(do
(println (:explain error))
(st/emit! (msg/error (tr "errors.generic"))))))
(defn- handle-register-success (defn- handle-register-success
[data] [data]
@ -186,8 +171,6 @@
(let [token (:invitation-token data)] (let [token (:invitation-token data)]
(st/emit! (rt/nav :auth-verify-token {} {:token token}))) (st/emit! (rt/nav :auth-verify-token {} {:token token})))
;; The :is-active flag is true, when insecure-register is enabled
;; or the user used external auth provider.
(:is-active data) (:is-active data)
(st/emit! (du/login-from-register)) (st/emit! (du/login-from-register))