Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-16 00:41:25 -05:00
Code Issues 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
backend
src/app
auth
oidc.clj
http
debug.clj
rpc/commands
auth.cljprofile.cljverify_token.clj
srepl
main.clj
test/backend_tests
rpc_profile_test.clj
frontend/src/app/main/ui/auth
login.cljsregister.cljs

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

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

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

@ -16,7 +16,6 @@
[app.config :as cf]
[app.db :as db]
[app.http.session :as session]
[app.main :as-alias main]
[app.rpc.commands.auth :as auth]
[app.rpc.commands.files-create :refer [create-file]]
[app.rpc.commands.profile :as profile]
@ -341,57 +340,57 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
(ex/raise :type :validation
:code :missing-force
:hint "missing force checkbox"))
(let [profile (some->> params
:email
(profile/clean-email)
(profile/get-profile-by-email conn))]
(let [profile (some->> params
:email
(profile/clean-email)
(profile/get-profile-by-email pool))]
(when-not profile
(ex/raise :type :validation
:code :missing-profile
:hint "unable to find profile by email"))
(when-not profile
(ex/raise :type :validation
:code :missing-profile
:hint "unable to find profile by email"))
(cond
(contains? params :block)
(do
(db/update! conn :profile {:is-blocked true} {:id (:id profile)})
(db/delete! conn :http-session {:profile-id (:id profile)})
(cond
(contains? params :block)
(do
(db/update! pool :profile {:is-blocked true} {:id (:id profile)})
(db/delete! pool :http-session {:profile-id (:id profile)})
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
(contains? params :unblock)
(do
(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)
(do
(db/update! pool :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 :resend)
(if (:is-blocked profile)
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body "PROFILE ALREADY BLOCKED"}
(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)
(if (:is-blocked profile)
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body "PROFILE ALREADY BLOCKED"}
(do
(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))}))))
:else
(do
(db/update! conn :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

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

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

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

@ -91,8 +91,8 @@
(defn get-profile
"Get profile by id. Throws not-found exception if no profile found."
[conn id & {:as attrs}]
(-> (db/get-by-id conn :profile id attrs)
[conn id & {:as opts}]
(-> (db/get-by-id conn :profile id opts)
(decode-row)))
;; --- 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.spec :as us]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.main :as-alias main]
@ -82,7 +83,16 @@
(defmethod process-token :auth
[{: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)))
;; --- Team Invitation

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

@ -86,13 +86,11 @@
(defn resend-email-verification-email!
[email]
(let [sprops (:app.setup/props main/system)
pool (:app.db/pool main/system)
email (profile/clean-email email)
profile (profile/get-profile-by-email pool email)]
(auth/send-email-verification! pool sprops profile)
:email-sent))
(db/tx-run! main/system
(fn [{:keys [::db/conn] :as cfg}]
(let [email (profile/clean-email email)
profile (profile/get-profile-by-email conn email)]
(#'auth/send-email-verification! cfg profile)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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/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}]
(let [current-token (atom nil)]
(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
(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
(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))))
;; 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
:token @current-token
:fullname "foobar"
@ -250,44 +281,56 @@
:accept-newsletter-subscription true}
out (th/command! data)]
(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
(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))))
;; DO REGISTRATION
(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/sleep {:millis 500})
(th/reset-mock! mock)
(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)]
(th/db-update! :profile
{:is-blocked true}
{:email "hello@example.com"})
(t/is (th/success? out))
(t/is (= 0 (:call-count @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))
(let [result (:result out)]
(t/is (contains? result :token))
(reset! current-token (:token result))))
;; DO REGISTRATION: try correct register attempt 1
(with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
:return true}]
;; 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 (th/success? out))
(t/is (= 1 (:call-count @mock))))))))
(t/is (nil? (:error out)))
(t/is (= 0 (:call-count @mock))))))))
(t/deftest prepare-and-register-with-invitation-and-disabled-registration-1
@ -359,13 +402,13 @@
:email (:email profile)
:password "foobar"}
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)))
(let [edata (-> out :error ex-data)]
(t/is (= :validation (:type edata)))
(t/is (= :email-already-exists (:code edata))))))
(t/deftest prepare-register-profile-with-bounced-email
(t/deftest register-profile-with-bounced-email
(let [pool (:app.db/pool th/*system*)
data {::th/type :prepare-register-profile
:email "user@example.com"
@ -374,10 +417,9 @@
(th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
(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/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(t/deftest register-profile-with-complained-email
(let [pool (:app.db/pool th/*system*)
@ -455,7 +497,7 @@
(t/deftest request-profile-recovery
(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})
pool (:app.db/pool th/*system*)
data {::th/type :request-profile-recovery}]
@ -468,38 +510,47 @@
;; with valid email inactive user
(let [data (assoc data :email (:email profile1))
out (th/command! data)
error (:error out)]
out (th/command! data)]
(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)))
(t/is (nil? (:result out)))
(t/is (nil? (:error out))))
(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
(let [data (assoc data :email (:email profile2))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 1 (:call-count @mock))))
(with-mocks [_ {:target 'app.rpc.commands.auth/elapsed-verify-threshold?
:return true}]
(let [data (assoc data :email (:email profile2))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(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)})
(let [data (assoc data :email (:email profile2))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
;; with valid email and active user with global complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email profile2)})
(let [data (assoc data :email (:email profile2))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(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)})
(let [data (assoc data :email (:email profile2))
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(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))))))
;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
(let [data (assoc data :email (:email profile2))
out (th/command! data)]
(t/is (nil? (:result out)))
(t/is (nil? (:error out)))
;; (th/print-result! out)
(t/is (= 2 (:call-count @mock))))))))
(t/deftest update-profile-password

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

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

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

@ -26,18 +26,20 @@
;; --- PAGE: Register
(defn- validate
(defn- validate-password-length
[errors data]
(let [password (:password data)]
(cond-> errors
(> 8 (count password))
(assoc :password {:message "errors.password-too-short"})
:always
(d/update-when :email
(fn [{:keys [code] :as error}]
(cond-> error
(= code ::us/email)
(assoc :message (tr "errors.email-invalid"))))))))
(assoc :password {:message "errors.password-too-short"}))))
(defn- validate-email
[errors _]
(d/update-when errors :email
(fn [{:keys [code] :as error}]
(cond-> error
(= code ::us/email)
(assoc :message (tr "errors.email-invalid"))))))
(s/def ::fullname ::us/not-empty-string)
(s/def ::password ::us/not-empty-string)
@ -49,31 +51,20 @@
(s/keys :req-un [::password ::email]
:opt-un [::invitation-token]))
(defn- handle-prepare-register-error
(defn- on-prepare-register-error
[form cause]
(let [{:keys [type code]} (ex-data cause)]
(condp = [type code]
[:restriction :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]
(swap! form assoc-in [:errors :password]
{:message "errors.email-as-password"})
(st/emit! (msg/error (tr "errors.generic"))))))
(defn- handle-prepare-register-success
(defn- on-prepare-register-success
[params]
(st/emit! (rt/nav :auth-register-validate {} params)))
@ -81,28 +72,30 @@
[{:keys [params on-success-callback]}]
(let [initial (mf/use-memo (mf/deps params) (constantly params))
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"))]
:initial initial)
submitted? (mf/use-state false)
on-success (fn [p]
(if (nil? on-success-callback)
(handle-prepare-register-success p)
(on-success-callback p)))
submitted? (mf/use-state false)
on-submit
(mf/use-fn
(mf/deps on-success-callback)
(fn [form _event]
(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)
(rx/map #(merge % params))
(rx/finalize #(reset! submitted? false))
(rx/subs!
on-success
(partial handle-prepare-register-error form))))))]
(rx/subs! on-success on-error)))))]
[:& fm/form {:on-submit on-submit :form form}
[:div {:class (stl/css :fields-row)}
@ -126,7 +119,6 @@
:data-test "register-form-submit"
:class (stl/css :register-btn)}]]))
(mf/defc register-methods
{::mf/props :obj}
[{:keys [params on-success-callback]}]
@ -169,15 +161,8 @@
;; --- PAGE: register validation
(defn- handle-register-error
[form error]
(case (:code error)
: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"))))))
[_form _data]
(st/emit! (msg/error (tr "errors.generic"))))
(defn- handle-register-success
[data]
@ -186,8 +171,6 @@
(let [token (:invitation-token data)]
(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)
(st/emit! (du/login-from-register))