mirror of
https://github.com/penpot/penpot.git
synced 2025-03-28 23:51:29 -05:00
- makes the profile access more efficient (replace in-app joins to a simple select query on profile table - add partial support for access-tokens (still missing some RPC methods) - move router definitions to specific modules and simplify the main http module definitions to simple includes - simplifiy authentication code related to access-tokens and sessions - normalize db parameters with proper namespaced props - more work on convert all modules initialization to use proper specs with fully-qualified keyword config props
308 lines
10 KiB
Clojure
308 lines
10 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC
|
|
|
|
(ns app.rpc.mutations.profile
|
|
(:require
|
|
[app.auth :as auth]
|
|
[app.common.data :as d]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.spec :as us]
|
|
[app.config :as cf]
|
|
[app.db :as db]
|
|
[app.emails :as eml]
|
|
[app.http.session :as session]
|
|
[app.loggers.audit :as audit]
|
|
[app.main :as-alias main]
|
|
[app.media :as media]
|
|
[app.rpc :as-alias rpc]
|
|
[app.rpc.climit :as-alias climit]
|
|
[app.rpc.commands.auth :as cmd.auth]
|
|
[app.rpc.commands.teams :as teams]
|
|
[app.rpc.doc :as-alias doc]
|
|
[app.rpc.helpers :as rph]
|
|
[app.rpc.queries.profile :as profile]
|
|
[app.storage :as sto]
|
|
[app.tokens :as tokens]
|
|
[app.util.services :as sv]
|
|
[app.util.time :as dt]
|
|
[app.worker :as-alias wrk]
|
|
[clojure.spec.alpha :as s]
|
|
[cuerdas.core :as str]
|
|
[promesa.core :as p]
|
|
[promesa.exec :as px]))
|
|
|
|
;; --- Helpers & Specs
|
|
|
|
(s/def ::email ::us/email)
|
|
(s/def ::fullname ::us/not-empty-string)
|
|
(s/def ::lang ::us/string)
|
|
(s/def ::path ::us/string)
|
|
(s/def ::profile-id ::us/uuid)
|
|
(s/def ::password ::us/not-empty-string)
|
|
(s/def ::old-password ::us/not-empty-string)
|
|
(s/def ::theme ::us/string)
|
|
|
|
;; --- MUTATION: Update Profile (own)
|
|
|
|
(s/def ::update-profile
|
|
(s/keys :req-un [::fullname ::profile-id]
|
|
:opt-un [::lang ::theme]))
|
|
|
|
(sv/defmethod ::update-profile
|
|
{::doc/added "1.0"}
|
|
[{:keys [::db/pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
|
|
(db/with-atomic [conn pool]
|
|
;; NOTE: we need to retrieve the profile independently if we use
|
|
;; it or not for explicit locking and avoid concurrent updates of
|
|
;; the same row/object.
|
|
(let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
|
|
(profile/decode-row))
|
|
|
|
;; Update the profile map with direct params
|
|
profile (-> profile
|
|
(assoc :fullname fullname)
|
|
(assoc :lang lang)
|
|
(assoc :theme theme))
|
|
]
|
|
|
|
(db/update! conn :profile
|
|
{:fullname fullname
|
|
:lang lang
|
|
:theme theme
|
|
:props (db/tjson (:props profile))}
|
|
{:id profile-id})
|
|
|
|
(-> profile
|
|
profile/strip-private-attrs
|
|
d/without-nils
|
|
(rph/with-meta {::audit/props (audit/profile->props profile)})))))
|
|
|
|
|
|
;; --- MUTATION: Update Password
|
|
|
|
(declare validate-password!)
|
|
(declare update-profile-password!)
|
|
(declare invalidate-profile-session!)
|
|
|
|
(s/def ::update-profile-password
|
|
(s/keys :req-un [::profile-id ::password ::old-password]))
|
|
|
|
(sv/defmethod ::update-profile-password
|
|
{::climit/queue :auth}
|
|
[{:keys [::db/pool] :as cfg} {:keys [password] :as params}]
|
|
(db/with-atomic [conn pool]
|
|
(let [profile (validate-password! conn params)
|
|
session-id (::rpc/session-id params)]
|
|
(when (= (str/lower (:email profile))
|
|
(str/lower (:password params)))
|
|
(ex/raise :type :validation
|
|
:code :email-as-password
|
|
:hint "you can't use your email as password"))
|
|
(update-profile-password! conn (assoc profile :password password))
|
|
(invalidate-profile-session! conn (:id profile) session-id)
|
|
nil)))
|
|
|
|
(defn- invalidate-profile-session!
|
|
"Removes all sessions except the current one."
|
|
[conn profile-id session-id]
|
|
(let [sql "delete from http_session where profile_id = ? and id != ?"]
|
|
(:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
|
|
|
|
(defn- validate-password!
|
|
[conn {:keys [profile-id old-password] :as params}]
|
|
(let [profile (db/get-by-id conn :profile profile-id)]
|
|
(when-not (:valid (auth/verify-password old-password (:password profile)))
|
|
(ex/raise :type :validation
|
|
:code :old-password-not-match))
|
|
profile))
|
|
|
|
(defn update-profile-password!
|
|
[conn {:keys [id password] :as profile}]
|
|
(db/update! conn :profile
|
|
{:password (auth/derive-password password)}
|
|
{:id id}))
|
|
|
|
;; --- MUTATION: Update Photo
|
|
|
|
(declare update-profile-photo)
|
|
|
|
(s/def ::file ::media/upload)
|
|
(s/def ::update-profile-photo
|
|
(s/keys :req-un [::profile-id ::file]))
|
|
|
|
(sv/defmethod ::update-profile-photo
|
|
[cfg {:keys [file] :as params}]
|
|
;; Validate incoming mime type
|
|
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
|
|
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
|
|
(update-profile-photo cfg params)))
|
|
|
|
(defn update-profile-photo
|
|
[{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
|
|
(p/let [profile (px/with-dispatch executor
|
|
(db/get-by-id pool :profile profile-id))
|
|
photo (teams/upload-photo cfg params)]
|
|
|
|
;; Schedule deletion of old photo
|
|
(when-let [id (:photo-id profile)]
|
|
(sto/touch-object! storage id))
|
|
|
|
;; Save new photo
|
|
(db/update! pool :profile
|
|
{:photo-id (:id photo)}
|
|
{:id profile-id})
|
|
|
|
(-> (rph/wrap)
|
|
(rph/with-meta {::audit/replace-props
|
|
{:file-name (:filename file)
|
|
:file-size (:size file)
|
|
:file-path (str (:path file))
|
|
:file-mtype (:mtype file)}}))))
|
|
|
|
;; --- MUTATION: Request Email Change
|
|
|
|
(declare request-email-change)
|
|
(declare change-email-immediately)
|
|
|
|
(s/def ::request-email-change
|
|
(s/keys :req-un [::email]))
|
|
|
|
(sv/defmethod ::request-email-change
|
|
[{:keys [::db/pool] :as cfg} {:keys [profile-id email] :as params}]
|
|
(db/with-atomic [conn pool]
|
|
(let [profile (db/get-by-id conn :profile profile-id)
|
|
cfg (assoc cfg :conn conn)
|
|
params (assoc params
|
|
:profile profile
|
|
:email (str/lower email))]
|
|
(if (contains? cf/flags :smtp)
|
|
(request-email-change cfg params)
|
|
(change-email-immediately cfg params)))))
|
|
|
|
(defn- change-email-immediately
|
|
[{:keys [conn]} {:keys [profile email] :as params}]
|
|
(when (not= email (:email profile))
|
|
(cmd.auth/check-profile-existence! conn params))
|
|
(db/update! conn :profile
|
|
{:email email}
|
|
{:id (:id profile)})
|
|
{:changed true})
|
|
|
|
(defn- request-email-change
|
|
[{:keys [conn] :as cfg} {:keys [profile email] :as params}]
|
|
(let [token (tokens/generate (::main/props cfg)
|
|
{:iss :change-email
|
|
:exp (dt/in-future "15m")
|
|
:profile-id (:id profile)
|
|
:email email})
|
|
ptoken (tokens/generate (::main/props cfg)
|
|
{:iss :profile-identity
|
|
:profile-id (:id profile)
|
|
:exp (dt/in-future {:days 30})})]
|
|
|
|
(when (not= email (:email profile))
|
|
(cmd.auth/check-profile-existence! conn params))
|
|
|
|
(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 (eml/has-bounce-reports? conn email)
|
|
(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"))
|
|
|
|
(eml/send! {::eml/conn conn
|
|
::eml/factory eml/change-email
|
|
:public-uri (cf/get :public-uri)
|
|
:to (:email profile)
|
|
:name (:fullname profile)
|
|
:pending-email email
|
|
:token token
|
|
:extra-data ptoken})
|
|
nil))
|
|
|
|
|
|
;; --- MUTATION: Update Profile Props
|
|
|
|
(s/def ::props map?)
|
|
(s/def ::update-profile-props
|
|
(s/keys :req-un [::profile-id ::props]))
|
|
|
|
(sv/defmethod ::update-profile-props
|
|
[{:keys [::db/pool] :as cfg} {:keys [profile-id props]}]
|
|
(db/with-atomic [conn pool]
|
|
(let [profile (profile/get-profile conn profile-id ::db/for-update? true)
|
|
props (reduce-kv (fn [props k v]
|
|
;; We don't accept namespaced keys
|
|
(if (simple-ident? k)
|
|
(if (nil? v)
|
|
(dissoc props k)
|
|
(assoc props k v))
|
|
props))
|
|
(:props profile)
|
|
props)]
|
|
|
|
(db/update! conn :profile
|
|
{:props (db/tjson props)}
|
|
{:id profile-id})
|
|
|
|
(profile/filter-props props))))
|
|
|
|
|
|
;; --- MUTATION: Delete Profile
|
|
|
|
(declare get-owned-teams-with-participants)
|
|
(declare check-can-delete-profile!)
|
|
(declare mark-profile-as-deleted!)
|
|
|
|
(s/def ::delete-profile
|
|
(s/keys :req-un [::profile-id]))
|
|
|
|
(sv/defmethod ::delete-profile
|
|
[{:keys [::db/pool] :as cfg} {:keys [profile-id] :as params}]
|
|
(db/with-atomic [conn pool]
|
|
(let [teams (get-owned-teams-with-participants conn profile-id)
|
|
deleted-at (dt/now)]
|
|
|
|
;; If we found owned teams with participants, we don't allow
|
|
;; delete profile until the user properly transfer ownership or
|
|
;; explicitly removes all participants from the team
|
|
(when (some pos? (map :participants teams))
|
|
(ex/raise :type :validation
|
|
:code :owner-teams-with-people
|
|
:hint "The user need to transfer ownership of owned teams."
|
|
:context {:teams (mapv :id teams)}))
|
|
|
|
(doseq [{:keys [id]} teams]
|
|
(db/update! conn :team
|
|
{:deleted-at deleted-at}
|
|
{:id id}))
|
|
|
|
(db/update! conn :profile
|
|
{:deleted-at deleted-at}
|
|
{:id profile-id})
|
|
|
|
(rph/with-transform {} (session/delete-fn cfg)))))
|
|
|
|
(def sql:owned-teams
|
|
"with owner_teams as (
|
|
select tpr.team_id as id
|
|
from team_profile_rel as tpr
|
|
where tpr.is_owner is true
|
|
and tpr.profile_id = ?
|
|
)
|
|
select tpr.team_id as id,
|
|
count(tpr.profile_id) - 1 as participants
|
|
from team_profile_rel as tpr
|
|
where tpr.team_id in (select id from owner_teams)
|
|
and tpr.profile_id != ?
|
|
group by 1")
|
|
|
|
(defn- get-owned-teams-with-participants
|
|
[conn profile-id]
|
|
(db/exec! conn [sql:owned-teams profile-id profile-id]))
|