3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-12 07:26:39 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Move profile queries and mutations to commands

Browse source
This commit is contained in:
Andrey Antukh 2023-01-14 12:11:45 +01:00
parent ecb757bcaf
commit d8faff47a8
18 changed files with 537 additions and 317 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -21,7 +21,7 @@
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.main :as-alias main]
[app.rpc.queries.profile :as profile]
[app.rpc.commands.profile :as profile]
[app.tokens :as tokens]
[app.util.json :as json]
[app.util.time :as dt]

5
backend/src/app/cli/manage.clj
View file

@ -11,8 +11,7 @@
[app.db :as db]
[app.main :as main]
[app.rpc.commands.auth :as auth]
[app.rpc.mutations.profile :as profile]
[app.rpc.queries.profile :refer [get-profile-by-email]]
[app.rpc.commands.profile :as profile]
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]
[integrant.core :as ig])
@ -80,7 +79,7 @@
(db/with-atomic [conn (:app.db/pool system)]
(let [email (or (:email options)
(read-from-console {:label "Email:"}))
profile (get-profile-by-email conn email)]
profile (profile/get-profile-by-email conn email)]
(when-not profile
(when (pos? (:verbosity options))
(println "Profile does not exists."))

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

@ -17,7 +17,7 @@
[app.http.session :as session]
[app.rpc.commands.binfile :as binf]
[app.rpc.commands.files.create :refer [create-file]]
[app.rpc.queries.profile :as profile]
[app.rpc.commands.profile :as profile]
[app.util.blob :as blob]
[app.util.template :as tmpl]
[app.util.time :as dt]

1
backend/src/app/rpc.clj
View file

@ -131,6 +131,7 @@
data (-> params
(assoc ::request-at (dt/now))
(assoc ::session/id (::session/id request))
(assoc ::http/request request)
(assoc ::cond/key etag)
(cond-> (uuid? profile-id)

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

@ -19,10 +19,10 @@
[app.main :as-alias main]
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit]
[app.rpc.commands.profile :as profile]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile]
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
@ -52,20 +52,6 @@
(str/split #"@" 2))]
(contains? domains candidate))))
(def ^:private sql:profile-existence
"select exists (select * from profile
where email = ?
and deleted_at is null) as val")
(defn check-profile-existence!
[conn {:keys [email] :as params}]
(let [email (str/lower email)
result (db/exec-one! conn [sql:profile-existence email])]
(when (:val result)
(ex/raise :type :validation
:code :email-already-exists))
params))
;; ---- COMMAND: login with password
(defn login-with-password

2
backend/src/app/rpc/commands/feedback.clj
View file

@ -13,8 +13,8 @@
[app.db :as db]
[app.emails :as eml]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.profile :as profile]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))

2
backend/src/app/rpc/commands/ldap.clj
View file

@ -15,9 +15,9 @@
[app.main :as-alias main]
[app.rpc :as-alias rpc]
[app.rpc.commands.auth :as auth]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile]
[app.tokens :as tokens]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))

424
backend/src/app/rpc/commands/profile.clj Normal file
View file

@ -0,0 +1,424 @@
;; 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.commands.profile
(:require
[app.auth :as auth]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[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 climit]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[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]))
(declare decode-row)
(declare get-profile)
(declare strip-private-attrs)
(declare filter-props)
(declare check-profile-existence!)
;; --- QUERY: Get profile (own)
(s/def ::get-profile
(s/keys :opt [::rpc/profile-id]))
(sv/defmethod ::get-profile
{::rpc/auth false
::doc/added "1.18"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
;; We need to return the anonymous profile object in two cases, when
;; no profile-id is in session, and when db call raises not found. In all other
;; cases we need to reraise the exception.
(try
(-> (get-profile pool profile-id)
(strip-private-attrs)
(update :props filter-props))
(catch Throwable _
{:id uuid/zero :fullname "Anonymous User"})))
(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)
(decode-row)))
;; --- MUTATION: Update Profile (own)
(s/def ::email ::us/email)
(s/def ::fullname ::us/not-empty-string)
(s/def ::lang ::us/string)
(s/def ::theme ::us/string)
(s/def ::update-profile
(s/keys :req [::rpc/profile-id]
:req-un [::fullname]
:opt-un [::lang ::theme]))
(sv/defmethod ::update-profile
{::doc/added "1.0"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/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)
(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
(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 ::password ::us/not-empty-string)
(s/def ::old-password ::us/not-empty-string)
(s/def ::update-profile-password
(s/keys :req [::rpc/profile-id]
:req-un [::password ::old-password]))
(sv/defmethod ::update-profile-password
{::climit/queue :auth}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}]
(db/with-atomic [conn pool]
(let [profile (validate-password! conn (assoc params :profile-id profile-id))
session-id (::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 profile-id 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 ::db/for-update? true)]
(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 upload-photo)
(declare update-profile-photo)
(s/def ::file ::media/upload)
(s/def ::update-profile-photo
(s/keys :req [::rpc/profile-id]
:req-un [::file]))
(sv/defmethod ::update-profile-photo
[cfg {:keys [::rpc/profile-id 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 (assoc params :profile-id profile-id))))
;; TODO: reimplement it without p/let
(defn update-profile-photo
[{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
(letfn [(on-uploaded [photo]
(let [profile (db/get-by-id pool :profile profile-id ::db/for-update? true)]
;; 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)}}))))]
(->> (upload-photo cfg params)
(p/fmap executor on-uploaded))))
(defn upload-photo
[{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
(letfn [(get-info [content]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :info :input content})))
(generate-thumbnail [info]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :profile-thumbnail
:format :jpeg
:quality 85
:width 256
:height 256
:input info})))
;; Function responsible of calculating cryptographyc hash of
;; the provided data.
(calculate-hash [data]
(px/with-dispatch executor
(sto/calculate-hash data)))]
(p/let [info (get-info file)
thumb (generate-thumbnail info)
hash (calculate-hash (:data thumb))
content (-> (sto/content (:data thumb) (:size thumb))
(sto/wrap-with-hash hash))]
(sto/put-object! storage {::sto/content content
::sto/deduplicate? true
:bucket "profile"
:content-type (:mtype thumb)}))))
;; --- MUTATION: Request Email Change
(declare ^:private request-email-change!)
(declare ^:private change-email-immediately!)
(s/def ::request-email-change
(s/keys :req [::rpc/profile-id]
:req-un [::email]))
(sv/defmethod ::request-email-change
[{:keys [::db/pool] :as cfg} {:keys [::rpc/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))
(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))
(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 [::rpc/profile-id]
:req-un [::props]))
(sv/defmethod ::update-profile-props
[{:keys [::db/pool]} {:keys [::rpc/profile-id props]}]
(db/with-atomic [conn pool]
(let [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})
(filter-props props))))
;; --- MUTATION: Delete Profile
(declare ^:private get-owned-teams-with-participants)
(s/def ::delete-profile
(s/keys :req [::rpc/profile-id]))
(sv/defmethod ::delete-profile
[{:keys [::db/pool] :as cfg} {:keys [::rpc/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)))))
;; --- HELPERS
(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]))
(def ^:private sql:profile-existence
"select exists (select * from profile
where email = ?
and deleted_at is null) as val")
(defn check-profile-existence!
[conn {:keys [email] :as params}]
(let [email (str/lower email)
result (db/exec-one! conn [sql:profile-existence email])]
(when (:val result)
(ex/raise :type :validation
:code :email-already-exists))
params))
(def ^:private sql:profile-by-email
"select p.* from profile as p
where p.email = ?
and (p.deleted_at is null or
p.deleted_at > now())")
(defn get-profile-by-email
"Returns a profile looked up by email or `nil` if not match found."
[conn email]
(->> (db/exec! conn [sql:profile-by-email (str/lower email)])
(map decode-row)
(first)))
(defn strip-private-attrs
"Only selects a publicly visible profile attrs."
[row]
(dissoc row :password :deleted-at))
(defn filter-props
"Removes all namespace qualified props from `props` attr."
[props]
(into {} (filter (fn [[k _]] (simple-ident? k))) props))
(defn decode-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props "jsonb")
(assoc :props (db/decode-transit-pgobject props))))

37
backend/src/app/rpc/commands/teams.clj
View file

@ -18,11 +18,10 @@
[app.main :as-alias main]
[app.media :as media]
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.rpc.quotes :as quotes]
[app.storage :as sto]
[app.tokens :as tokens]
@ -572,7 +571,7 @@
;; --- Mutation: Update Team Photo
(declare ^:private upload-photo)
(declare upload-photo)
(declare ^:private update-team-photo)
(s/def ::file ::media/upload)
@ -592,7 +591,7 @@
[{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
(p/let [team (px/with-dispatch executor
(retrieve-team pool profile-id team-id))
photo (upload-photo cfg params)]
photo (profile/upload-photo cfg params)]
;; Mark object as touched for make it ellegible for tentative
;; garbage collection.
@ -606,36 +605,6 @@
(assoc team :photo-id (:id photo))))
(defn upload-photo
[{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
(letfn [(get-info [content]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :info :input content})))
(generate-thumbnail [info]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :profile-thumbnail
:format :jpeg
:quality 85
:width 256
:height 256
:input info})))
;; Function responsible of calculating cryptographyc hash of
;; the provided data.
(calculate-hash [data]
(px/with-dispatch executor
(sto/calculate-hash data)))]
(p/let [info (get-info file)
thumb (generate-thumbnail info)
hash (calculate-hash (:data thumb))
content (-> (sto/content (:data thumb) (:size thumb))
(sto/wrap-with-hash hash))]
(sto/put-object! storage {::sto/content content
::sto/deduplicate? true
:bucket "profile"
:content-type (:mtype thumb)}))))
;; --- Mutation: Create Team Invitation

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

@ -13,10 +13,10 @@
[app.loggers.audit :as audit]
[app.main :as-alias main]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile]
[app.rpc.quotes :as quotes]
[app.tokens :as tokens]
[app.tokens.spec.team-invitation :as-alias spec.team-invitation]

169
backend/src/app/rpc/mutations/profile.clj
View file

@ -6,33 +6,23 @@
(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.commands.profile :as profile]
[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]))
[cuerdas.core :as str]))
;; --- Helpers & Specs
@ -52,7 +42,8 @@
:opt-un [::lang ::theme]))
(sv/defmethod ::update-profile
{::doc/added "1.0"}
{::doc/added "1.0"
::doc/deprecated "1.18"}
[{: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
@ -76,156 +67,68 @@
{:id profile-id})
(-> profile
profile/strip-private-attrs
d/without-nils
(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}
{::climit/queue :auth
::doc/added "1.0"
::doc/deprecated "1.18"}
[{: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)]
(let [profile (#'profile/validate-password! conn params)
session-id (::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)
(profile/update-profile-password! conn (assoc profile :password password))
(#'profile/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
{::doc/added "1.0"
::doc/deprecated "1.18"}
[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)}}))))
(profile/update-profile-photo cfg params)))
;; --- 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
{::doc/added "1.0"
::doc/deprecated "1.18"}
[{: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)
cfg (assoc cfg ::profile/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))
(#'profile/request-email-change! cfg params)
(#'profile/change-email-immediately! cfg params)))))
;; --- MUTATION: Update Profile Props
@ -234,6 +137,8 @@
(s/keys :req-un [::profile-id ::props]))
(sv/defmethod ::update-profile-props
{::doc/added "1.0"
::doc/deprecated "1.18"}
[{: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)
@ -256,17 +161,15 @@
;; --- 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
{::doc/added "1.0"
::doc/deprecated "1.18"}
[{: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)
(let [teams (#'profile/get-owned-teams-with-participants conn profile-id)
deleted-at (dt/now)]
;; If we found owned teams with participants, we don't allow
@ -288,21 +191,3 @@
{: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]))

74
backend/src/app/rpc/queries/profile.clj
View file

@ -6,81 +6,27 @@
(ns app.rpc.queries.profile
(:require
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
[clojure.spec.alpha :as s]))
;; --- Helpers & Specs
(s/def ::email ::us/email)
(s/def ::fullname ::us/string)
(s/def ::old-password ::us/string)
(s/def ::password ::us/string)
(s/def ::path ::us/string)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::theme ::us/string)
;; --- Query: Profile (own)
(declare decode-row)
(declare get-profile)
(declare strip-private-attrs)
(declare filter-props)
(s/def ::profile
(s/keys :opt-un [::profile-id]))
(s/def ::profile ::profile/get-profile)
(sv/defmethod ::profile
{::rpc/auth false}
{::rpc/auth false
::doc/added "1.0"
::doc/deprecated "1.18"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id]}]
;; We need to return the anonymous profile object in two cases, when
;; no profile-id is in session, and when db call raises not found. In all other
;; cases we need to reraise the exception.
(try
(-> (get-profile pool profile-id)
(strip-private-attrs)
(update :props filter-props))
(-> (profile/get-profile pool profile-id)
(profile/strip-private-attrs)
(update :props profile/filter-props))
(catch Throwable _
{:id uuid/zero :fullname "Anonymous User"})))
(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)
(decode-row)))
(def ^:private sql:profile-by-email
"select p.* from profile as p
where p.email = ?
and (p.deleted_at is null or
p.deleted_at > now())")
(defn get-profile-by-email
"Returns a profile looked up by email or `nil` if not match found."
[conn email]
(->> (db/exec! conn [sql:profile-by-email (str/lower email)])
(map decode-row)
(first)))
;; --- HELPERS
(defn strip-private-attrs
"Only selects a publicly visible profile attrs."
[row]
(dissoc row :password :deleted-at))
(defn filter-props
"Removes all namespace qualified props from `props` attr."
[props]
(into {} (filter (fn [[k _]] (simple-ident? k))) props))
(defn decode-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props "jsonb")
(assoc :props (db/decode-transit-pgobject props))))

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

@ -12,8 +12,8 @@
[app.common.pprint :as p]
[app.common.spec :as us]
[app.db :as db]
[app.rpc.commands.auth :as cmd.auth]
[app.rpc.queries.profile :as profile]
[app.rpc.commands.auth :as auth]
[app.rpc.commands.profile :as profile]
[app.srepl.fixes :as f]
[app.srepl.helpers :as h]
[app.util.blob :as blob]
@ -73,7 +73,7 @@
pool (:app.db/pool system)
profile (profile/get-profile-by-email pool email)]
(cmd.auth/send-email-verification! pool sprops profile)
(auth/send-email-verification! pool sprops profile)
:email-sent))
(defn mark-profile-as-active!