🎉 Add the ability to completly block access to a profile

backend/src/app/auth/oidc.clj

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

backend/src/app/migrations.clj

@@ -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")}
    ])
 
 

backend/src/app/migrations/sql/0079-mod-profile-table.sql

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

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

@@ -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
-                    (ex/raise :type :validation
+                    (:is-blocked profile)
-                              :code :email-already-exists
+                    (ex/raise :type :restriction
-                              :hint "profile already exists and correctly validated")
+                              :code :profile-blocked)
-                    (if (elapsed-register-retry-threshold? profile)
+
+                    (and (not (:is-active profile))
+                         (elapsed-register-retry-threshold? profile))
                     profile
+
+                    :else
                     (ex/raise :type :validation
                               :code :email-already-exists
-                                :hint "profile already exists"))))
+                              :hint "profile already exists")))
 
         params  {:email (:email params)
                  :password (:password params)

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

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

backend/src/app/srepl/main.clj

@@ -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)
+  (let [params (cond-> {}
-        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)
+    (db/with-atomic [conn (:app.db/pool system)]
-            (profile/decode-profile-row))))
+      (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))))

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

@@ -83,8 +83,18 @@
         form    (fm/use-form :spec ::login-form :initial initial)
 
         on-error
-        (fn [_]
+        (fn [cause]
-          (reset! error (tr "errors.wrong-credentials")))
+          (cond
+            (and (= :restriction (:type cause))
+                 (= :profile-blocked (:code cause)))
+            (reset! error (tr "errors.profile-blocked"))
+
+            (and (= :validation (:type cause))
+                 (= :wrong-credentials (:code cause)))
+            (reset! error (tr "errors.wrong-credentials"))
+
+            :else
+            (reset! error (tr "errors.generic"))))
 
         on-success-default
         (fn [data]

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

@@ -48,20 +48,23 @@
           :opt-un [::invitation-token]))
 
 (defn- handle-prepare-register-error
-  [form error]
+  [form {:keys [type code] :as cause}]
-  (case (:code error)
+  (condp = [type code]
-    :registration-disabled
+    [:restriction :registration-disabled]
     (st/emit! (dm/error (tr "errors.registration-disabled")))
 
-    :email-has-permanent-bounces
+    [:restriction :profile-blocked]
+    (st/emit! (dm/error (tr "errors.profile-blocked")))
+
+    [:validation :email-has-permanent-bounces]
     (let [email (get @form [:data :email])]
       (st/emit! (dm/error (tr "errors.email-has-permanent-bounces" email))))
 
-    :email-already-exists
+    [:validation :email-already-exists]
     (swap! form assoc-in [:errors :email]
            {:message "errors.email-already-exists"})
 
-    :email-as-password
+    [:validation :email-as-password]
     (swap! form assoc-in [:errors :password]
            {:message "errors.email-as-password"})
 

frontend/translations/en.po

@@ -4559,3 +4559,6 @@ msgstr "Update"
 
 msgid "workspace.viewport.click-to-close-path"
 msgstr "Click to close the path"
+
+msgid "errors.profile-blocked"
+msgstr "The profile is blocked"

frontend/translations/es.po

@@ -4766,3 +4766,6 @@ msgstr "Actualizar"
 
 msgid "workspace.viewport.click-to-close-path"
 msgstr "Pulsar para cerrar la ruta"
+
+msgid "errors.profile-blocked"
+msgstr "El perfil esta blockeado"