🎉 Add the ability to completly block access to a profile

This commit is contained in:
Andrey Antukh 2022-09-22 16:48:16 +02:00
parent 37e2fe5c65
commit 757cee67fb
10 changed files with 83 additions and 27 deletions

View file

@ -434,6 +434,10 @@
(assoc :path "/#/auth/verify-token")
(assoc :query (u/map->query-string params)))]
(when (:is-blocked profile)
(ex/raise :type :restriction
:code :profile-blocked))
(when (fn? audit)
(audit :cmd :submit
:type "command"

View file

@ -244,6 +244,9 @@
{:name "0078-mod-file-media-object-table-drop-cascade"
:fn (mg/resource "app/migrations/sql/0078-mod-file-media-object-table-drop-cascade.sql")}
{:name "0079-mod-profile-table"
:fn (mg/resource "app/migrations/sql/0079-mod-profile-table.sql")}
])

View file

@ -0,0 +1,2 @@
ALTER TABLE profile
ADD COLUMN is_blocked boolean DEFAULT false;

View file

@ -97,15 +97,19 @@
(:valid (verify-password password (:password profile))))
(validate-profile [profile]
(when-not (:is-active profile)
(ex/raise :type :validation
:code :wrong-credentials))
(when-not profile
(ex/raise :type :validation
:code :wrong-credentials))
(when-not (:is-active profile)
(ex/raise :type :validation
:code :wrong-credentials))
(when (:is-blocked profile)
(ex/raise :type :restriction
:code :profile-blocked))
(when-not (check-password profile password)
(ex/raise :type :validation
:code :wrong-credentials))
profile)]
(db/with-atomic [conn pool]
@ -231,15 +235,19 @@
(validate-register-attempt! cfg params)
(let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))]
(if (:is-active profile)
(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 and correctly validated")
(if (elapsed-register-retry-threshold? profile)
profile
(ex/raise :type :validation
:code :email-already-exists
:hint "profile already exists"))))
:hint "profile already exists")))
params {:email (:email params)
:password (:password params)

View file

@ -46,6 +46,11 @@
:code :wrong-credentials))
(let [profile (login-or-register cfg info)]
(when (:is-blocked profile)
(ex/raise :type :restriction
:code :profile-blocked))
(if-let [token (:invitation-token params)]
;; If invitation token comes in params, this is because the
;; user comes from team-invitation process; in this case,

View file

@ -64,7 +64,7 @@
(defn update-profile
"Update a limited set of profile attrs."
[system & {:keys [email id active? deleted?]}]
[system & {:keys [email id active? deleted? blocked?]}]
(us/verify!
:expr (some? system)
@ -74,15 +74,30 @@
:expr (or (string? email) (uuid? id))
:hint "email or id should be provided")
(let [pool (:app.db/pool system)
params (cond-> {}
(let [params (cond-> {}
(true? active?) (assoc :is-active true)
(false? active?) (assoc :is-active false)
(true? deleted?) (assoc :deleted-at (dt/now)))
(true? deleted?) (assoc :deleted-at (dt/now))
(true? blocked?) (assoc :is-blocked true)
(false? blocked?) (assoc :is-blocked false))
opts (cond-> {}
(some? email) (assoc :email (str/lower email))
(some? id) (assoc :id id))]
(some-> (db/update! pool :profile params opts)
(profile/decode-profile-row))))
(db/with-atomic [conn (:app.db/pool system)]
(some-> (db/update! conn :profile params opts)
(profile/decode-profile-row)))))
(defn mark-profile-as-blocked!
"Mark the profile blocked and removes all the http sessiones
associated with the profile-id."
[system email]
(db/with-atomic [conn (:app.db/pool system)]
(when-let [profile (db/get-by-params conn :profile
{:email (str/lower email)}
{:columns [:id :email]
:check-not-found false})]
(when-not (:is-blocked profile)
(db/update! conn :profile {:is-blocked true} {:id (:id profile)})
(db/delete! conn :http-session {:profile-id (:id profile)})
:blocked))))