0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-27 23:21:47 -05:00

♻️ Move profile queries and mutations to commands

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

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]

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."))

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]

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)

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

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]))

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]))

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))))

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

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]

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]))

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))))

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!

View file

@ -6,14 +6,14 @@
(ns backend-tests.rpc-profile-test
(:require
[backend-tests.helpers :as th]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cauth]
[app.rpc.mutations.profile :as profile]
[app.tokens :as tokens]
[app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.java.io :as io]
[clojure.test :as t]
[cuerdas.core :as str]
@ -67,9 +67,9 @@
(t/deftest profile-query-and-manipulation
(let [profile (th/create-profile* 1)]
(t/testing "query profile"
(let [data {::th/type :profile
:profile-id (:id profile)}
out (th/query! data)]
(let [data {::th/type :get-profile
::rpc/profile-id (:id profile)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@ -82,20 +82,20 @@
(t/testing "update profile"
(let [data (assoc profile
::th/type :update-profile
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:fullname "Full Name"
:lang "en"
:theme "dark")
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (map? (:result out)))))
(t/testing "query profile after update"
(let [data {::th/type :profile
:profile-id (:id profile)}
out (th/query! data)]
(let [data {::th/type :get-profile
::rpc/profile-id (:id profile)}
out (th/command! data)]
#_(th/print-result! out)
(t/is (nil? (:error out)))
@ -107,12 +107,12 @@
(t/testing "update photo"
(let [data {::th/type :update-profile-photo
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:file {:filename "sample.jpg"
:size 123123
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"}}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))))
@ -131,8 +131,8 @@
;; Request profile to be deleted
(let [params {::th/type :delete-profile
:profile-id (:id prof)}
out (th/mutation! params)]
::rpc/profile-id (:id prof)}
out (th/command! params)]
(t/is (nil? (:error out))))
;; query files after profile soft deletion
@ -154,9 +154,9 @@
(t/is (dt/instant? (:deleted-at row))))
;; query profile after delete
(let [params {::th/type :profile
:profile-id (:id prof)}
out (th/query! params)]
(let [params {::th/type :get-profile
::rpc/profile-id (:id prof)}
out (th/command! params)]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= uuid/zero (:id result)))))))
@ -174,7 +174,7 @@
(let [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "foobar"}
out (th/mutation! data)
out (th/command! data)
token (get-in out [:result :token])]
(t/is (string? token))
@ -183,7 +183,7 @@
(let [data {::th/type :register-profile
:fullname "foobar"
:accept-terms-and-privacy true}
out (th/mutation! data)]
out (th/command! data)]
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
@ -195,7 +195,7 @@
:fullname "foobar"
:accept-terms-and-privacy true
:accept-newsletter-subscription true}]
(let [{:keys [result error]} (th/mutation! data)]
(let [{:keys [result error]} (th/command! data)]
(t/is (nil? error))))
))
@ -413,11 +413,11 @@
(let [profile (th/create-profile* 1)
pool (:app.db/pool th/*system*)
data {::th/type :request-email-change
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:email "user1@example.com"}]
;; without complaints
(let [out (th/mutation! data)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(let [mock @mock]
@ -426,14 +426,14 @@
;; with complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email data)})
(let [out (th/mutation! data)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
;; with bounces
(th/create-global-complaint-for pool {:type :bounce :email (:email data)})
(let [out (th/mutation! data)
(let [out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
@ -448,9 +448,9 @@
(let [profile (th/create-profile* 1)
pool (:app.db/pool th/*system*)
data {::th/type :request-email-change
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:email "user1@example.com"}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (false? (:called? @mock)))
@ -467,7 +467,7 @@
;; with invalid email
(let [data (assoc data :email "foo@bar.com")
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:result out)))
(t/is (= 0 (:call-count @mock))))
@ -512,10 +512,10 @@
(t/deftest update-profile-password
(let [profile (th/create-profile* 1)
data {::th/type :update-profile-password
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:old-password "123123"
:password "foobarfoobar"}
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
))
@ -524,10 +524,10 @@
(t/deftest update-profile-password-bad-old-password
(let [profile (th/create-profile* 1)
data {::th/type :update-profile-password
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:old-password "badpassword"
:password "foobarfoobar"}
{:keys [result error] :as out} (th/mutation! data)]
{:keys [result error] :as out} (th/command! data)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :old-password-not-match))))
@ -536,10 +536,10 @@
(t/deftest update-profile-password-email-as-password
(let [profile (th/create-profile* 1)
data {::th/type :update-profile-password
:profile-id (:id profile)
::rpc/profile-id (:id profile)
:old-password "123123"
:password "profile1.test@nodomain.com"}
{:keys [result error] :as out} (th/mutation! data)]
{:keys [result error] :as out} (th/command! data)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :email-as-password))))

View file

@ -124,7 +124,7 @@
(ptk/reify ::fetch-profile
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query! :profile)
(->> (rp/cmd! :get-profile)
(rx/map profile-fetched)))))
;; --- EVENT: INITIALIZE PROFILE
@ -207,7 +207,7 @@
;; the returned profile is an NOT authenticated profile, we
;; proceed to logout and show an error message.
(->> (rp/command! :login-with-password (d/without-nils params))
(->> (rp/cmd! :login-with-password (d/without-nils params))
(rx/merge-map (fn [data]
(rx/merge
(rx/of (fetch-profile))
@ -293,7 +293,7 @@
(ptk/reify ::logout
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/command! :logout)
(->> (rp/cmd! :logout)
(rx/delay-at-least 300)
(rx/catch (constantly (rx/of 1)))
(rx/map #(logged-out params)))))))
@ -309,7 +309,7 @@
(let [mdata (meta data)
on-success (:on-success mdata identity)
on-error (:on-error mdata rx/throw)]
(->> (rp/mutation :update-profile (dissoc data :props))
(->> (rp/cmd! :update-profile (dissoc data :props))
(rx/catch on-error)
(rx/mapcat
(fn [_]
@ -333,7 +333,7 @@
(let [{:keys [on-error on-success]
:or {on-error identity
on-success identity}} (meta data)]
(->> (rp/mutation :request-email-change data)
(->> (rp/cmd! :request-email-change data)
(rx/tap on-success)
(rx/catch on-error))))))
@ -343,7 +343,7 @@
(ptk/reify ::cancel-email-change
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :cancel-email-change {})
(->> (rp/cmd! :cancel-email-change {})
(rx/map (constantly (fetch-profile)))))))
;; --- Update Password (Form)
@ -364,7 +364,7 @@
on-success identity}} (meta data)
params {:old-password (:password-old data)
:password (:password-1 data)}]
(->> (rp/mutation :update-profile-password params)
(->> (rp/cmd! :update-profile-password params)
(rx/tap on-success)
(rx/catch (fn [err]
(on-error err)
@ -382,7 +382,7 @@
;; the response value of update-profile-props RPC call
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :update-profile-props {:props props})
(->> (rp/cmd! :update-profile-props {:props props})
(rx/map (constantly (fetch-profile)))))))
(defn mark-onboarding-as-viewed
@ -394,7 +394,7 @@
(let [version (or version (:main @cf/version))
props {:onboarding-viewed true
:release-notes-viewed version}]
(->> (rp/mutation :update-profile-props {:props props})
(->> (rp/cmd! :update-profile-props {:props props})
(rx/map (constantly (fetch-profile)))))))))
(defn mark-questions-as-answered
@ -407,7 +407,7 @@
ptk/WatchEvent
(watch [_ _ _]
(let [props {:onboarding-questions-answered true}]
(->> (rp/mutation :update-profile-props {:props props})
(->> (rp/cmd! :update-profile-props {:props props})
(rx/map (constantly (fetch-profile))))))))
@ -431,7 +431,7 @@
(->> (rx/of file)
(rx/map di/validate-file)
(rx/map prepare)
(rx/mapcat #(rp/mutation :update-profile-photo %))
(rx/mapcat #(rp/cmd! :update-profile-photo %))
(rx/do on-success)
(rx/map (constantly (fetch-profile)))
(rx/catch on-error))))))
@ -460,7 +460,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/command! :get-profiles-for-file-comments {:team-id team-id :share-id share-id})
(->> (rp/cmd! :get-profiles-for-file-comments {:team-id team-id :share-id share-id})
(rx/map #(partial fetched %))))))))
;; --- EVENT: request-account-deletion
@ -473,7 +473,7 @@
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta params)]
(->> (rp/mutation :delete-profile {})
(->> (rp/cmd! :delete-profile {})
(rx/tap on-success)
(rx/delay-at-least 300)
(rx/catch (constantly (rx/of 1)))
@ -495,7 +495,7 @@
:or {on-error rx/throw
on-success identity}} (meta data)]
(->> (rp/command! :request-profile-recovery data)
(->> (rp/cmd! :request-profile-recovery data)
(rx/tap on-success)
(rx/catch on-error))))))
@ -514,7 +514,7 @@
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta data)]
(->> (rp/command! :recover-profile data)
(->> (rp/cmd! :recover-profile data)
(rx/tap on-success)
(rx/catch on-error))))))
@ -525,7 +525,7 @@
(ptk/reify ::create-demo-profile
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/command! :create-demo-profile {})
(->> (rp/cmd! :create-demo-profile {})
(rx/map login)))))

View file

@ -214,7 +214,7 @@
:features features}]
(when (:id params)
(->> (rp/mutation :update-file params)
(->> (rp/cmd! :update-file params)
(rx/ignore)))))))
(defn update-persistence-status

View file

@ -23,6 +23,7 @@
(derive :get-team-stats ::query)
(derive :get-team-invitations ::query)
(derive :get-team-shared-files ::query)
(derive :get-profile ::query)
(defn handle-response
[{:keys [status body] :as response}]
@ -191,3 +192,12 @@
:body (http/form-data params)})
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defmethod command ::multipart-upload
[id params]
(->> (http/send! {:method :post
:uri (u/join @cf/public-uri "api/rpc/command/" (name id))
:credentials "include"
:body (http/form-data params)})
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))

View file

@ -99,7 +99,7 @@
;; We just recheck with an additional profile request; this avoids
;; some race conditions that causes unexpected redirects on
;; invitations workflows (and probably other cases).
(->> (rp/query! :profile)
(->> (rp/command! :get-profile)
(rx/subs (fn [{:keys [id] :as profile}]
(if (= id uuid/zero)
(st/emit! (rt/nav :auth-login))