github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-05-08 17:48:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #2661 from penpot/niwinz-enhancements-3

Browse Source 
Enhancements & Bugfixes
This commit is contained in:
Alejandro 2022-12-16 12:09:57 +01:00 committed by GitHub
commit 61c1b65072
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
51 changed files with 1508 additions and 1249 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.clj-kondo/config.edn
View File

@ -45,6 +45,15 @@
:redundant-do
{:level :off}
:earmuffed-var-not-dynamic
{:level :off}
:dynamic-var-not-earmuffed
{:level :off}
:used-underscored-binding
{:level :warning}
:unused-binding
{:exclude-destructured-as true
:exclude-destructured-keys-in-fn-args false

19
backend/resources/app/templates/api-doc-entry.tmpl
View File

@ -6,14 +6,21 @@
<div class="tags">
{% if item.deprecated %}
<span class="tag">
<span>Deprecated:</span>
<span>since v{{item.deprecated}}</span>,
<span>DEPRECATED</span>
</span>
{% endif %}
{% if item.auth %}
<span class="tag">
<span>AUTH</span>
</span>
{% endif %}
{% if item.webhook %}
<span class="tag">
<span>WEBHOOK</span>
</span>
{% endif %}
<span class="tag">
<span>Auth:</span>
<span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
</span>
</div>
</div>
<div class="rpc-row-detail hidden">

8
backend/src/app/http/client.clj
View File

@ -11,7 +11,8 @@
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[java-http-clj.core :as http])
[java-http-clj.core :as http]
[promesa.core :as p])
(:import
java.net.http.HttpClient))
@ -34,7 +35,10 @@
(us/assert! ::client client)
(if sync?
(http/send req {:client client :as response-type})
(http/send-async req {:client client :as response-type}))))
(try
(http/send-async req {:client client :as response-type})
(catch Throwable cause
(p/rejected cause))))))
(defn req!
"A convencience toplevel function for gradual migration to a new API

44
backend/src/app/http/session.clj
View File

@ -12,6 +12,7 @@
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.main :as-alias main]
[app.tokens :as tokens]
[app.util.time :as dt]
[app.worker :as wrk]
@ -56,13 +57,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- prepare-session-params
[sprops data]
[props data]
(let [profile-id (:profile-id data)
user-agent (:user-agent data)
created-at (or (:created-at data) (dt/now))
token (tokens/generate sprops {:iss "authentication"
:iat created-at
:uid profile-id})]
token (tokens/generate props {:iss "authentication"
:iat created-at
:uid profile-id})]
{:user-agent user-agent
:profile-id profile-id
:created-at created-at
@ -70,7 +71,7 @@
:id token}))
(defn- database-manager
[{:keys [pool sprops executor]}]
[{:keys [::db/pool ::wrk/executor ::main/props]}]
(reify ISessionManager
(read [_ token]
(px/with-dispatch executor
@ -78,11 +79,11 @@
(decode [_ token]
(px/with-dispatch executor
(tokens/verify sprops {:token token :iss "authentication"})))
(tokens/verify props {:token token :iss "authentication"})))
(write! [_ _ data]
(px/with-dispatch executor
(let [params (prepare-session-params sprops data)]
(let [params (prepare-session-params props data)]
(db/insert! pool :http-session params)
params)))
@ -100,7 +101,7 @@
nil))))
(defn inmemory-manager
[{:keys [sprops executor]}]
[{:keys [::wrk/executor ::main/props]}]
(let [cache (atom {})]
(reify ISessionManager
(read [_ token]
@ -108,11 +109,11 @@
(decode [_ token]
(px/with-dispatch executor
(tokens/verify sprops {:token token :iss "authentication"})))
(tokens/verify props {:token token :iss "authentication"})))
(write! [_ _ data]
(p/do
(let [{:keys [token] :as params} (prepare-session-params sprops data)]
(let [{:keys [token] :as params} (prepare-session-params props data)]
(swap! cache assoc token params)
params)))
@ -127,12 +128,11 @@
(swap! cache dissoc token)
nil)))))
(s/def ::sprops map?)
(defmethod ig/pre-init-spec ::manager [_]
(s/keys :req-un [::db/pool ::wrk/executor ::sprops]))
(s/keys :req [::db/pool ::wrk/executor ::main/props]))
(defmethod ig/init-key ::manager
[_ {:keys [pool] :as cfg}]
[_ {:keys [::db/pool] :as cfg}]
(if (db/read-only? pool)
(inmemory-manager cfg)
(database-manager cfg)))
@ -179,17 +179,13 @@
(def middleware-1
(letfn [(wrap-handler [manager handler request respond raise]
(try
(let [claims (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
(yrq/get-cookie request)
(decode manager))
request (cond-> request
(some? claims)
(assoc :session-token-claims claims))]
(handler request respond raise))
(catch Throwable _
(handler request respond raise))))]
(when-let [cookie (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
(yrq/get-cookie request))]
(->> (decode manager (:value cookie))
(p/fnly (fn [claims _]
(cond-> request
(some? claims) (assoc :session-token-claims claims)
:always (handler respond raise)))))))]
{:name :session-1
:compile (fn [& _]
(fn [handler manager]

44
backend/src/app/loggers/audit.clj
View File

@ -21,6 +21,7 @@
[app.main :as-alias main]
[app.metrics :as mtx]
[app.tokens :as tokens]
[app.util.retry :as rtry]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
@ -147,35 +148,46 @@
:name (:name event)
:type (:type event)
:profile-id (:profile-id event)
:tracked-at (dt/now)
:ip-addr (:ip-addr event)
:props (:props event)}]
(when (contains? cf/flags :audit-log)
(db/insert! pool :audit-log
(-> params
(update :props db/tjson)
(update :ip-addr db/inet)
(assoc :source "backend"))))
;; NOTE: this operation may cause primary key conflicts on inserts
;; because of the timestamp precission (two concurrent requests), in
;; this case we just retry the operation.
(rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 6
::rtry/label "persist-audit-log-event"}
(let [now (dt/now)]
(db/insert! pool :audit-log
(-> params
(update :props db/tjson)
(update :ip-addr db/inet)
(assoc :created-at now)
(assoc :tracked-at now)
(assoc :source "backend"))))))
(when (and (contains? cf/flags :webhooks)
(::webhooks/event? event))
(let [batch-key (::webhooks/batch-key event)
batch-timeout (::webhooks/batch-timeout event)]
batch-timeout (::webhooks/batch-timeout event)
label-suffix (when (ifn? batch-key)
(str/ffmt ":%" (batch-key (:props params))))
dedupe? (boolean
(and batch-key batch-timeout))]
(wrk/submit! ::wrk/conn pool
::wrk/task :process-webhook-event
::wrk/queue :webhooks
::wrk/max-retries 0
::wrk/delay (or batch-timeout 0)
::wrk/label (cond
(fn? batch-key) (batch-key (:props event))
(keyword? batch-key) (name batch-key)
(string? batch-key) batch-key
:else "default")
::wrk/dedupe true
::webhooks/event (-> params
(dissoc :ip-addr)
(dissoc :type)))))))
::wrk/dedupe dedupe?
::wrk/label
(str/ffmt "rpc:%1%2" (:name params) label-suffix)
::webhooks/event
(-> params
(dissoc :ip-addr)
(dissoc :type)))))))
(defn submit!
"Submit audit event to the collector."

10
backend/src/app/loggers/webhooks.clj
View File

@ -25,11 +25,11 @@
(defn- lookup-webhooks-by-team
[pool team-id]
(db/exec! pool ["select * from webhook where team_id=? and is_active=true" team-id]))
(db/exec! pool ["select w.* from webhook as w where team_id=? and is_active=true" team-id]))
(defn- lookup-webhooks-by-project
[pool project-id]
(let [sql [(str "select * from webhook as w"
(let [sql [(str "select w.* from webhook as w"
" join project as p on (p.team_id = w.team_id)"
" where p.id = ? and w.is_active = true")
project-id]]
@ -37,7 +37,7 @@
(defn- lookup-webhooks-by-file
[pool file-id]
(let [sql [(str "select * from webhook as w"
(let [sql [(str "select w.* from webhook as w"
" join project as p on (p.team_id = w.team_id)"
" join file as f on (f.project_id = p.id)"
" where f.id = ? and w.is_active = true")
@ -62,7 +62,6 @@
:name (:name event))
(when-let [items (lookup-webhooks cfg event)]
;; (app.common.pprint/pprint items)
(l/trace :hint "webhooks found for event" :total (count items))
(db/with-atomic [conn pool]
@ -169,6 +168,9 @@
(instance? java.net.ConnectException cause)
"connection-error"
(instance? java.lang.IllegalArgumentException cause)
"invalid-uri"
(instance? java.net.http.HttpConnectTimeoutException cause)
"timeout"
))

8
backend/src/app/main.clj
View File

@ -207,9 +207,9 @@
{::wrk/executor (ig/ref ::wrk/executor)}
:app.http.session/manager
{:pool (ig/ref ::db/pool)
:sprops (ig/ref :app.setup/props)
:executor (ig/ref ::wrk/executor)}
{::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props)}
:app.http.session/gc-task
{:pool (ig/ref ::db/pool)
@ -322,7 +322,7 @@
::http.client/client (ig/ref ::http.client/client)
::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props)
:pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager)
:sprops (ig/ref :app.setup/props)

30
backend/src/app/rpc.clj
View File

@ -105,7 +105,7 @@
"Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow."
[methods {:keys [profile-id session-id params] :as request} respond raise]
(let [cmd (keyword (:command params))
(let [cmd (keyword (:type params))
etag (yrq/get-header request "if-none-match")
data (into {::http/request request ::cond/key etag} params)
data (if profile-id
@ -157,12 +157,13 @@
(:profile-id params)
uuid/zero)
props (or (::audit/replace-props resultm)
(-> params
(d/without-qualified)
(merge (::audit/props resultm))
(dissoc :profile-id)
(dissoc :type)))
props (-> (or (::audit/replace-props resultm)
(-> params
(merge (::audit/props resultm))
(dissoc :profile-id)
(dissoc :type)))
(d/without-qualified)
(d/without-nils))
event {:type (or (::audit/type resultm)
(::type cfg))
@ -212,7 +213,7 @@
(l/debug :hint "register method" :name (::sv/name mdata))
(with-meta
(fn [{:keys [::request] :as params}]
(fn [params]
;; Raise authentication error when rpc method requires auth but
;; no profile-id is found in the request.
@ -221,8 +222,8 @@
(ex/raise :type :authentication
:code :authentication-required
:hint "authentication required for this endpoint")
(let [params (us/conform spec (dissoc params ::request))]
(f cfg (assoc params ::request request))))))
(let [params (us/conform spec params)]
(f cfg params)))))
mdata)))
(defn- process-method
@ -237,7 +238,6 @@
(->> (sv/scan-ns 'app.rpc.queries.projects
'app.rpc.queries.files
'app.rpc.queries.teams
'app.rpc.queries.comments
'app.rpc.queries.profile
'app.rpc.queries.viewer
'app.rpc.queries.fonts)
@ -250,13 +250,10 @@
(->> (sv/scan-ns 'app.rpc.mutations.media
'app.rpc.mutations.profile
'app.rpc.mutations.files
'app.rpc.mutations.comments
'app.rpc.mutations.projects
'app.rpc.mutations.teams
'app.rpc.mutations.management
'app.rpc.mutations.fonts
'app.rpc.mutations.share-link
'app.rpc.mutations.verify-token)
'app.rpc.mutations.share-link)
(map (partial process-method cfg))
(into {}))))
@ -268,6 +265,7 @@
'app.rpc.commands.management
'app.rpc.commands.verify-token
'app.rpc.commands.search
'app.rpc.commands.teams
'app.rpc.commands.auth
'app.rpc.commands.ldap
'app.rpc.commands.demo
@ -331,7 +329,7 @@
(defmethod ig/init-key ::routes
[_ {:keys [methods] :as cfg}]
[["/rpc"
["/command/:command" {:handler (partial rpc-command-handler (:commands methods))}]
["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}]
["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}]
["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods))
:allowed-methods #{:post}}]]])

2
backend/src/app/rpc/commands/auth.clj
View File

@ -16,9 +16,9 @@
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.rpc.climit :as climit]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile]
[app.tokens :as tokens]
[app.util.services :as sv]

19
backend/src/app/rpc/commands/binfile.clj
View File

@ -15,6 +15,7 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.loggers.webhooks :as-alias webhooks]
[app.media :as media]
[app.rpc.commands.files :as files]
[app.rpc.doc :as-alias doc]
@ -840,10 +841,10 @@
(defn import!
[{:keys [::input] :as cfg}]
(let [id (uuid/next)
ts (dt/now)
tp (dt/tpoint)
cs (volatile! nil)]
(l/info :hint "import: started" :import-id id)
(try
(l/info :hint "start importation" :import-id id)
(binding [*position* (atom 0)]
(with-open [^AutoCloseable input (io/input-stream input)]
(read-import! (assoc cfg ::input input))))
@ -853,10 +854,12 @@
(throw cause))
(finally
(l/info :hint "importation finished" :import-id id
:elapsed (str (inst-ms (dt/diff ts (dt/now))) "ms")
(l/info :hint "import: terminated"
:import-id id
:elapsed (dt/format-duration (tp))
:error? (some? @cs)
:cause @cs)))))
:cause @cs
)))))
;; --- Command: export-binfile
@ -870,7 +873,8 @@
(sv/defmethod ::export-binfile
"Export a penpot file in a binary format."
{::doc/added "1.15"}
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}]
(files/check-read-permissions! pool profile-id file-id)
(let [body (reify yrs/StreamableResponseBody
@ -890,7 +894,8 @@
(sv/defmethod ::import-binfile
"Import a penpot file in a binary format."
{::doc/added "1.15"}
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [profile-id project-id file] :as params}]
(db/with-atomic [conn pool]
(projects/check-read-permissions! conn profile-id project-id)

26
backend/src/app/rpc/commands/comments.clj
View File

@ -10,12 +10,14 @@
[app.common.geom.point :as gpt]
[app.common.spec :as us]
[app.db :as db]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.teams :as teams]
[app.rpc.retry :as retry]
[app.rpc.helpers :as rph]
[app.util.blob :as blob]
[app.util.retry :as rtry]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
@ -86,6 +88,7 @@
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::get-unread-comment-threads
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
@ -133,6 +136,7 @@
:opt-un [::share-id]))
(sv/defmethod ::get-comment-thread
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id id share-id] :as params}]
(with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id)
@ -160,6 +164,7 @@
:opt-un [::share-id]))
(sv/defmethod ::get-comments
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id thread-id share-id] :as params}]
(with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)]
@ -245,14 +250,16 @@
:opt-un [::share-id]))
(sv/defmethod ::create-comment-thread
{::retry/max-retries 3
::retry/matches retry/conflict-db-insert?
::doc/added "1.15"
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
(db/with-atomic [conn pool]
(files/check-comment-permissions! conn profile-id file-id share-id)
(create-comment-thread conn params)))
(rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 3
::rtry/label "create-comment-thread"}
(create-comment-thread conn params))))
(defn- retrieve-next-seqn
[conn file-id]
@ -421,7 +428,9 @@
(upsert-comment-thread-status! conn profile-id thread-id)
;; Return the created comment object.
comment)))
(rph/with-meta comment
{::audit/props {:file-id (:file-id thread)
:share-id nil}}))))
;; --- COMMAND: Update Comment
@ -487,8 +496,7 @@
(s/keys :req-un [::profile-id ::id]))
(sv/defmethod ::delete-comment
{::doc/added "1.15"
::webhooks/event? true}
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})]

2
backend/src/app/rpc/commands/files.clj
View File

@ -19,13 +19,13 @@
[app.db.sql :as sql]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc.commands.files.thumbnails :as-alias thumbs]
[app.rpc.commands.teams :as teams]
[app.rpc.cond :as-alias cond]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.queries.projects :as projects]
[app.rpc.queries.share-link :refer [retrieve-share-link]]
[app.rpc.queries.teams :as teams]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]

8
backend/src/app/rpc/commands/files/update.clj
View File

@ -123,16 +123,12 @@
;; set is different than the persisted one, update it on the
;; database.
(defn webhook-batch-keyfn
[props]
(str "rpc:update-file:" (:id props)))
(sv/defmethod ::update-file
{::climit/queue :update-file
::climit/key-fn :id
::webhooks/event? true
::webhooks/batch-timeout (dt/duration "2s")
::webhooks/batch-key webhook-batch-keyfn
::webhooks/batch-timeout (dt/duration "2m")
::webhooks/batch-key :id
::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]

19
backend/src/app/rpc/commands/management.clj
View File

@ -13,12 +13,12 @@
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc.commands.binfile :as binfile]
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams :refer [create-project-role create-project]]
[app.rpc.doc :as-alias doc]
[app.rpc.mutations.projects :refer [create-project-role create-project]]
[app.rpc.queries.projects :as proj]
[app.rpc.queries.teams :as teams]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
@ -43,7 +43,8 @@
(sv/defmethod ::duplicate-file
"Duplicate a single file in the same team."
{::doc/added "1.16"}
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(duplicate-file conn params)))
@ -216,7 +217,8 @@
(sv/defmethod ::duplicate-project
"Duplicate an entire project with all the files"
{::doc/added "1.16"}
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(duplicate-project conn params)))
@ -324,7 +326,8 @@
(sv/defmethod ::move-files
"Move a set of files from one project to other."
{::doc/added "1.16"}
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(move-files conn params)))
@ -363,7 +366,8 @@
(sv/defmethod ::move-project
"Move projects between teams."
{::doc/added "1.16"}
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(move-project conn params)))
@ -378,7 +382,8 @@
(sv/defmethod ::clone-template
"Clone into the specified project the template by its id."
{::doc/added "1.16"}
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(-> (assoc cfg :conn conn)

850
backend/src/app/rpc/commands/teams.clj Normal file
View File

@ -0,0 +1,850 @@
;; 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.teams
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.emails :as eml]
[app.loggers.audit :as audit]
[app.main :as-alias main]
[app.media :as media]
[app.rpc.climit :as climit]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.storage :as sto]
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[promesa.core :as p]
[promesa.exec :as px]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(def ^:private sql:team-permissions
"select tpr.is_owner,
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
join team as t on (t.id = tpr.team_id)
where tpr.profile_id = ?
and tpr.team_id = ?
and t.deleted_at is null")
(defn get-permissions
[conn profile-id team-id]
(let [rows (db/exec! conn [sql:team-permissions profile-id team-id])
is-owner (boolean (some :is-owner rows))
is-admin (boolean (some :is-admin rows))
can-edit (boolean (some :can-edit rows))]
(when (seq rows)
{:is-owner is-owner
:is-admin (or is-owner is-admin)
:can-edit (or is-owner is-admin can-edit)
:can-read true})))
(def has-edit-permissions?
(perms/make-edition-predicate-fn get-permissions))
(def has-read-permissions?
(perms/make-read-predicate-fn get-permissions))
(def check-edition-permissions!
(perms/make-check-fn has-edit-permissions?))
(def check-read-permissions!
(perms/make-check-fn has-read-permissions?))
;; --- Query: Teams
(declare retrieve-teams)
(s/def ::get-teams
(s/keys :req-un [::profile-id]))
(sv/defmethod ::get-teams
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id]}]
(with-open [conn (db/open pool)]
(retrieve-teams conn profile-id)))
(def sql:teams
"select t.*,
tp.is_owner,
tp.is_admin,
tp.can_edit,
(t.id = ?) as is_default
from team_profile_rel as tp
join team as t on (t.id = tp.team_id)
where t.deleted_at is null
and tp.profile_id = ?
order by tp.created_at asc")
(defn process-permissions
[team]
(let [is-owner (:is-owner team)
is-admin (:is-admin team)
can-edit (:can-edit team)
permissions {:type :membership
:is-owner is-owner
:is-admin (or is-owner is-admin)
:can-edit (or is-owner is-admin can-edit)}]
(-> team
(dissoc :is-owner :is-admin :can-edit)
(assoc :permissions permissions))))
(defn retrieve-teams
[conn profile-id]
(let [defaults (profile/retrieve-additional-data conn profile-id)]
(->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id])
(mapv process-permissions))))
;; --- Query: Team (by ID)
(declare retrieve-team)
(s/def ::get-team
(s/keys :req-un [::profile-id ::id]))
(sv/defmethod ::get-team
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id id]}]
(with-open [conn (db/open pool)]
(retrieve-team conn profile-id id)))
(defn retrieve-team
[conn profile-id team-id]
(let [defaults (profile/retrieve-additional-data conn profile-id)
sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
result (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])]
(when-not result
(ex/raise :type :not-found
:code :team-does-not-exist))
(process-permissions result)))
;; --- Query: Team Members
(def sql:team-members
"select tp.*,
p.id,
p.email,
p.fullname as name,
p.fullname as fullname,
p.photo_id,
p.is_active
from team_profile_rel as tp
join profile as p on (p.id = tp.profile_id)
where tp.team_id = ?")
(defn retrieve-team-members
[conn team-id]
(db/exec! conn [sql:team-members team-id]))
(s/def ::team-id ::us/uuid)
(s/def ::get-team-members
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::get-team-members
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id)))
;; --- Query: Team Users
(declare retrieve-users)
(declare retrieve-team-for-file)
(s/def ::get-team-users
(s/and (s/keys :req-un [::profile-id]
:opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %))))
(sv/defmethod ::get-team-users
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id file-id]}]
(with-open [conn (db/open pool)]
(if team-id
(do
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id))
(let [{team-id :id} (retrieve-team-for-file conn file-id)]
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id)))))
;; This is a similar query to team members but can contain more data
;; because some user can be explicitly added to project or file (not
;; implemented in UI)
(def sql:team-users
"select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
where tpr.team_id = ?
union
select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
inner join project as p on (ppr.project_id = p.id)
where p.team_id = ?
union
select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
inner join file as f on (fpr.file_id = f.id)
inner join project as p on (f.project_id = p.id)
where p.team_id = ?")
(def sql:team-by-file
"select p.team_id as id
from project as p
join file as f on (p.id = f.project_id)
where f.id = ?")
(defn retrieve-users
[conn team-id]
(db/exec! conn [sql:team-users team-id team-id team-id]))
(defn retrieve-team-for-file
[conn file-id]
(->> [sql:team-by-file file-id]
(db/exec-one! conn)))
;; --- Query: Team Stats
(declare retrieve-team-stats)
(s/def ::get-team-stats
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::get-team-stats
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id)))
(def sql:team-stats
"select (select count(*) from project where team_id = ?) as projects,
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
(defn retrieve-team-stats
[conn team-id]
(db/exec-one! conn [sql:team-stats team-id team-id]))
;; --- Query: Team invitations
(s/def ::get-team-invitations
(s/keys :req-un [::profile-id ::team-id]))
(def sql:team-invitations
"select email_to as email, role, (valid_until < now()) as expired
from team_invitation where team_id = ? order by valid_until desc, created_at desc")
(defn get-team-invitations
[conn team-id]
(->> (db/exec! conn [sql:team-invitations team-id])
(mapv #(update % :role keyword))))
(sv/defmethod ::get-team-invitations
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(get-team-invitations conn team-id)))
;; --- Mutation: Create Team
(declare create-team)
(declare create-project)
(declare create-project-role)
(declare ^:private create-team*)
(declare ^:private create-team-role)
(declare ^:private create-team-default-project)
(s/def ::create-team
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(sv/defmethod ::create-team
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(create-team conn params)))
(defn create-team
"This is a complete team creation process, it creates the team
object and all related objects (default role and default project)."
[conn params]
(let [team (create-team* conn params)
params (assoc params
:team-id (:id team)
:role :owner)
project (create-team-default-project conn params)]
(create-team-role conn params)
(assoc team :default-project-id (:id project))))
(defn- create-team*
[conn {:keys [id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :team
{:id id
:name name
:is-default is-default})))
(defn- create-team-role
[conn {:keys [team-id profile-id role] :as params}]
(let [params {:team-id team-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :team-profile-rel))))
(defn- create-team-default-project
[conn {:keys [team-id profile-id] :as params}]
(let [project {:id (uuid/next)
:team-id team-id
:name "Drafts"
:is-default true}
project (create-project conn project)]
(create-project-role conn {:project-id (:id project)
:profile-id profile-id
:role :owner})
project))
;; NOTE: we have project creation here because there are cyclic
;; dependency between teams and projects namespaces, and the project
;; creation happens in both sides, on team creation and on simple
;; project creation, so it make sense to have this functions in this
;; namespace too.
(defn create-project
[conn {:keys [id team-id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :project
{:id id
:name name
:team-id team-id
:is-default is-default})))
(defn create-project-role
[conn {:keys [project-id profile-id role]}]
(let [params {:project-id project-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :project-profile-rel))))
;; --- Mutation: Update Team
(s/def ::update-team
(s/keys :req-un [::profile-id ::name ::id]))
(sv/defmethod ::update-team
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [id name profile-id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id id)
(db/update! conn :team
{:name name}
{:id id})
nil))
;; --- Mutation: Leave Team
(declare role->params)
(s/def ::reassign-to ::us/uuid)
(s/def ::leave-team
(s/keys :req-un [::profile-id ::id]
:opt-un [::reassign-to]))
(defn leave-team
[conn {:keys [id profile-id reassign-to]}]
(let [perms (get-permissions conn profile-id id)
members (retrieve-team-members conn id)]
(cond
;; we can only proceed if there are more members in the team
;; besides the current profile
(<= (count members) 1)
(ex/raise :type :validation
:code :no-enough-members-for-leave
:context {:members (count members)})
;; if the `reassign-to` is filled and has a different value
;; than the current profile-id, we proceed to reassing the
;; owner role to profile identified by the `reassign-to`.
(and reassign-to (not= reassign-to profile-id))
(let [member (d/seek #(= reassign-to (:id %)) members)]
(when-not member
(ex/raise :type :not-found :code :member-does-not-exist))
;; unasign owner role to current profile
(db/update! conn :team-profile-rel
{:is-owner false}
{:team-id id
:profile-id profile-id})
;; assign owner role to new profile
(db/update! conn :team-profile-rel
(role->params :owner)
{:team-id id :profile-id reassign-to}))
;; and finally, if all other conditions does not match and the
;; current profile is owner, we dont allow it because there
;; must always be an owner.
(:is-owner perms)
(ex/raise :type :validation
:code :owner-cant-leave-team
:hint "releasing owner before leave"))
(db/delete! conn :team-profile-rel
{:profile-id profile-id
:team-id id})
nil))
(sv/defmethod ::leave-team
{::doc/added "1.17"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(leave-team conn params)))
;; --- Mutation: Delete Team
(s/def ::delete-team
(s/keys :req-un [::profile-id ::id]))
;; TODO: right now just don't allow delete default team, in future it
;; should raise a specific exception for signal that this action is
;; not allowed.
(sv/defmethod ::delete-team
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id id)]
(when-not (:is-owner perms)
(ex/raise :type :validation
:code :only-owner-can-delete-team))
(db/update! conn :team
{:deleted-at (dt/now)}
{:id id :is-default false})
nil)))
;; --- Mutation: Team Update Role
(s/def ::team-id ::us/uuid)
(s/def ::member-id ::us/uuid)
;; Temporarily disabled viewer role
;; https://tree.taiga.io/project/uxboxproject/issue/1083
;; (s/def ::role #{:owner :admin :editor :viewer})
(s/def ::role #{:owner :admin :editor})
(defn role->params
[role]
(case role
:admin {:is-owner false :is-admin true :can-edit true}
:editor {:is-owner false :is-admin false :can-edit true}
:owner {:is-owner true :is-admin true :can-edit true}
:viewer {:is-owner false :is-admin false :can-edit false}))
(defn update-team-member-role
[conn {:keys [team-id profile-id member-id role] :as params}]
;; We retrieve all team members instead of query the
;; database for a single member. This is just for
;; convenience, if this becomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanisms.
(let [perms (get-permissions conn profile-id team-id)
members (retrieve-team-members conn team-id)
member (d/seek #(= member-id (:id %)) members)
is-owner? (:is-owner perms)
is-admin? (:is-admin perms)]
;; If no member is found, just 404
(when-not member
(ex/raise :type :not-found
:code :member-does-not-exist))
;; First check if we have permissions to change roles
(when-not (or is-owner? is-admin?)
(ex/raise :type :validation
:code :insufficient-permissions))
;; Don't allow change role of owner member
(when (:is-owner member)
(ex/raise :type :validation
:code :cant-change-role-to-owner))
;; Don't allow promote to owner to admin users.
(when (and (not is-owner?) (= role :owner))
(ex/raise :type :validation
:code :cant-promote-to-owner))
(let [params (role->params role)]
;; Only allow single owner on team
(when (= role :owner)
(db/update! conn :team-profile-rel
{:is-owner false}
{:team-id team-id
:profile-id profile-id}))
(db/update! conn :team-profile-rel
params
{:team-id team-id
:profile-id member-id})
nil)))
(s/def ::update-team-member-role
(s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
(sv/defmethod ::update-team-member-role
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(update-team-member-role conn params)))
;; --- Mutation: Delete Team Member
(s/def ::delete-team-member
(s/keys :req-un [::profile-id ::team-id ::member-id]))
(sv/defmethod ::delete-team-member
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]
(when-not (or (:is-owner perms)
(:is-admin perms))
(ex/raise :type :validation
:code :insufficient-permissions))
(when (= member-id profile-id)
(ex/raise :type :validation
:code :cant-remove-yourself))
(db/delete! conn :team-profile-rel {:profile-id member-id
:team-id team-id})
nil)))
;; --- Mutation: Update Team Photo
(declare ^:private upload-photo)
(declare ^:private update-team-photo)
(s/def ::file ::media/upload)
(s/def ::update-team-photo
(s/keys :req-un [::profile-id ::team-id ::file]))
(sv/defmethod ::update-team-photo
{::doc/added "1.17"}
[cfg {:keys [file] :as params}]
;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
(let [cfg (update cfg :storage media/configure-assets-storage)]
(update-team-photo cfg params)))
(defn update-team-photo
[{:keys [pool storage 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)]
;; Mark object as touched for make it ellegible for tentative
;; garbage collection.
(when-let [id (:photo-id team)]
(sto/touch-object! storage id))
;; Save new photo
(db/update! pool :team
{:photo-id (:id photo)}
{:id team-id})
(assoc team :photo-id (:id photo))))
(defn upload-photo
[{:keys [storage 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
(def sql:upsert-team-invitation
"insert into team_invitation(team_id, email_to, role, valid_until)
values (?, ?, ?, ?)
on conflict(team_id, email_to) do
update set role = ?, updated_at = now();")
(defn- create-invitation-token
[cfg {:keys [expire profile-id team-id member-id member-email role]}]
(tokens/generate (::main/props cfg)
{:iss :team-invitation
:exp expire
:profile-id profile-id
:role role
:team-id team-id
:member-email member-email
:member-id member-id}))
(defn- create-profile-identity-token
[cfg profile]
(tokens/generate (::main/props cfg)
{:iss :profile-identity
:profile-id (:id profile)
:exp (dt/in-future {:days 30})}))
(defn- create-invitation
[{:keys [::conn] :as cfg} {:keys [team profile role email] :as params}]
(let [member (profile/retrieve-profile-data-by-email conn email)
expire (dt/in-future "168h") ;; 7 days
itoken (create-invitation-token cfg {:profile-id (:id profile)
:expire expire
:team-id (:id team)
:member-email (or (:email member) email)
:member-id (:id member)
:role role})
ptoken (create-profile-identity-token cfg profile)]
(when (and member (not (eml/allow-send-emails? conn member)))
(ex/raise :type :validation
:code :member-is-muted
:email email
:hint "the profile has reported repeatedly as spam or has bounces"))
;; Secondly check if the invited member email is part of the global spam/bounce report.
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
:code :email-has-permanent-bounces
:email email
:hint "the email you invite has been repeatedly reported as spam or bounce"))
(when (contains? cf/flags :log-invitation-tokens)
(l/trace :hint "invitation token" :token itoken))
;; When we have email verification disabled and invitation user is
;; already present in the database, we proceed to add it to the
;; team as-is, without email roundtrip.
;; TODO: if member does not exists and email verification is
;; disabled, we should proceed to create the profile (?)
(if (and (not (contains? cf/flags :email-verification))
(some? member))
(let [params (merge {:team-id (:id team)
:profile-id (:id member)}
(role->params role))]
;; Insert the invited member to the team
(db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
;; If profile is not yet verified, mark it as verified because
;; accepting an invitation link serves as verification.
(when-not (:is-active member)
(db/update! conn :profile
{:is-active true}
{:id (:id member)})))
(do
(db/exec-one! conn [sql:upsert-team-invitation
(:id team) (str/lower email) (name role) expire (name role)])
(eml/send! {::eml/conn conn
::eml/factory eml/invite-to-team
:public-uri (cf/get :public-uri)
:to email
:invited-by (:fullname profile)
:team (:name team)
:token itoken
:extra-data ptoken})))
itoken))
(s/def ::email ::us/email)
(s/def ::emails ::us/set-of-valid-emails)
(s/def ::create-team-invitations
(s/keys :req-un [::profile-id ::team-id ::role]
:opt-un [::email ::emails]))
(sv/defmethod ::create-team-invitations
"A rpc call that allow to send a single or multiple invitations to
join the team."
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id email emails role] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
team (db/get-by-id conn :team team-id)
emails (cond-> (or emails #{}) (string? email) (conj email))]
(when-not (:is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
;; First check if the current profile is allowed to send emails.
(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"))
(let [cfg (assoc cfg ::conn conn)
invitations (->> emails
(map (fn [email]
{:email (str/lower email)
:team team
:profile profile
:role role}))
(map (partial create-invitation cfg)))]
(with-meta (vec invitations)
{::audit/props {:invitations (count invitations)}})))))
;; --- Mutation: Create Team & Invite Members
(s/def ::emails ::us/set-of-valid-emails)
(s/def ::create-team-with-invitations
(s/merge ::create-team
(s/keys :req-un [::emails ::role])))
(sv/defmethod ::create-team-with-invitations
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}]
(db/with-atomic [conn pool]
(let [team (create-team conn params)
profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg ::conn conn)]
;; Create invitations for all provided emails.
(->> emails
(map (fn [email]
{:team team
:profile profile
:email (str/lower email)
:role role}))
(run! (partial create-invitation cfg)))
(-> team
(vary-meta assoc ::audit/props {:invitations (count emails)})
(rph/with-defer
#(when-let [collector (::audit/collector cfg)]
(audit/submit! collector
{:type "command"
:name "create-team-invitations"
:profile-id profile-id
:props {:emails emails
:role role
:profile-id profile-id
:invitations (count emails)}})))))))
;; --- Query: get-team-invitation-token
(s/def ::get-team-invitation-token
(s/keys :req-un [::profile-id ::team-id ::email]))
(sv/defmethod ::get-team-invitation-token
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email] :as params}]
(check-read-permissions! pool profile-id team-id)
(let [invit (-> (db/get pool :team-invitation
{:team-id team-id
:email-to (str/lower email)})
(update :role keyword))
member (profile/retrieve-profile-data-by-email pool (:email invit))
token (create-invitation-token cfg {:team-id (:team-id invit)
:profile-id profile-id
:expire (:expire invit)
:role (:role invit)
:member-id (:id member)
:member-email (or (:email member) (:email-to invit))})]
{:token token}))
;; --- Mutation: Update invitation role
(s/def ::update-team-invitation-role
(s/keys :req-un [::profile-id ::team-id ::email ::role]))
(sv/defmethod ::update-team-invitation-role
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id email role] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]
(when-not (:is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
(db/update! conn :team-invitation
{:role (name role) :updated-at (dt/now)}
{:team-id team-id :email-to (str/lower email)})
nil)))
;; --- Mutation: Delete invitation
(s/def ::delete-team-invitation
(s/keys :req-un [::profile-id ::team-id ::email]))
(sv/defmethod ::delete-team-invitation
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id email] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]
(when-not (:is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
(db/delete! conn :team-invitation
{:team-id team-id :email-to (str/lower email)})
nil)))

4
backend/src/app/rpc/commands/verify_token.clj
View File

@ -11,9 +11,9 @@
[app.db :as db]
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile]
[app.tokens :as tokens]
[app.tokens.spec.team-invitation :as-alias spec.team-invitation]
@ -129,7 +129,7 @@
[{:keys [conn session] :as cfg} {:keys [profile-id token]}
{:keys [member-id team-id member-email] :as claims}]
(us/assert ::team-invitation-claims claims)
(us/verify! ::team-invitation-claims claims)
(let [invitation (db/get* conn :team-invitation
{:team-id team-id :email-to member-email})

9
backend/src/app/rpc/commands/webhooks.clj
View File

@ -12,8 +12,8 @@
[app.db :as db]
[app.http.client :as http]
[app.loggers.webhooks :as webhooks]
[app.rpc.commands.teams :refer [check-edition-permissions! check-read-permissions!]]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.teams :refer [check-edition-permissions! check-read-permissions!]]
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as-alias wrk]
@ -74,7 +74,8 @@
(when (>= total max-hooks-for-team)
(ex/raise :type :restriction
:code :webhooks-quote-reached
:hint (str/ffmt "can't create more than % webhooks per team" max-hooks-for-team)))))
:hint (str/ffmt "can't create more than % webhooks per team"
max-hooks-for-team)))))
(defn- insert-webhook!
[{:keys [::db/pool]} {:keys [team-id uri mtype is-active] :as params}]
@ -99,8 +100,8 @@
{::doc/added "1.17"}
[{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
(check-edition-permissions! pool profile-id team-id)
(->> (validate-quotes! cfg params)
(p/fmap executor (fn [_] (validate-webhook! cfg nil params)))
(validate-quotes! cfg params)
(->> (validate-webhook! cfg nil params)
(p/fmap executor (fn [_] (insert-webhook! cfg params)))))
(s/def ::update-webhook

3
backend/src/app/rpc/doc.clj
View File

@ -9,6 +9,7 @@
(:require
[app.common.data :as d]
[app.config :as cf]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.util.services :as sv]
[app.util.template :as tmpl]
@ -35,6 +36,7 @@
:name (d/name name)
:module (-> (:ns mdata) (str/split ".") last)
:auth (:auth mdata true)
:webhook (::webhooks/event? mdata false)
:docs (::sv/docstring mdata)
:deprecated (::deprecated mdata)
:added (::added mdata)
@ -51,6 +53,7 @@
(->> (:queries methods)
(map (partial gen-doc :query))
(sort-by (juxt :module :name)))
:mutation-methods
(->> (:mutations methods)
(map (partial gen-doc :query))

123
backend/src/app/rpc/mutations/comments.clj
View File

@ -1,123 +0,0 @@
;; 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.comments
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.rpc.commands.comments :as cmd.comments]
[app.rpc.commands.files :as cmd.files]
[app.rpc.doc :as-alias doc]
[app.rpc.retry :as retry]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Mutation: Create Comment Thread
(s/def ::create-comment-thread ::cmd.comments/create-comment-thread)
(sv/defmethod ::create-comment-thread
{::retry/max-retries 3
::retry/matches retry/conflict-db-insert?
::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
(db/with-atomic [conn pool]
(cmd.files/check-comment-permissions! conn profile-id file-id share-id)
(cmd.comments/create-comment-thread conn params)))
;; --- Mutation: Update Comment Thread Status
(s/def ::id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::update-comment-thread-status ::cmd.comments/update-comment-thread-status)
(sv/defmethod ::update-comment-thread-status
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id share-id] :as params}]
(db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not cthr (ex/raise :type :not-found))
(cmd.files/check-comment-permissions! conn profile-id (:file-id cthr) share-id)
(cmd.comments/upsert-comment-thread-status! conn profile-id (:id cthr)))))
;; --- Mutation: Update Comment Thread
(s/def ::update-comment-thread ::cmd.comments/update-comment-thread)
(sv/defmethod ::update-comment-thread
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id is-resolved share-id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread
(ex/raise :type :not-found))
(cmd.files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(db/update! conn :comment-thread
{:is-resolved is-resolved}
{:id id})
nil)))
;; --- Mutation: Add Comment
(s/def ::add-comment ::cmd.comments/create-comment)
(sv/defmethod ::add-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.comments/create-comment conn params)))
;; --- Mutation: Update Comment
(s/def ::update-comment ::cmd.comments/update-comment)
(sv/defmethod ::update-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.comments/update-comment conn params)))
;; --- Mutation: Delete Comment Thread
(s/def ::delete-comment-thread ::cmd.comments/delete-comment-thread)
(sv/defmethod ::delete-comment-thread
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation :code :not-allowed))
(db/delete! conn :comment-thread {:id id})
nil)))
;; --- Mutation: Delete comment
(s/def ::delete-comment ::cmd.comments/delete-comment)
(sv/defmethod ::delete-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})]
(when-not (= (:owner-id comment) profile-id)
(ex/raise :type :validation :code :not-allowed))
(db/delete! conn :comment {:id id}))))

48
backend/src/app/rpc/mutations/fonts.clj
View File

@ -15,9 +15,9 @@
[app.loggers.webhooks :as-alias webhooks]
[app.media :as media]
[app.rpc.climit :as-alias climit]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
[app.util.services :as sv]
[app.util.time :as dt]
@ -110,12 +110,12 @@
]
(->> (generate-fonts data)
(p/map validate-data)
(p/fmap validate-data)
(p/mcat executor persist-fonts)
(p/map executor insert-into-db)
(p/map (fn [result]
(let [params (update params :data (comp vec keys))]
(rph/with-meta result {::audit/replace-props params})))))))
(p/fmap executor insert-into-db)
(p/fmap (fn [result]
(let [params (update params :data (comp vec keys))]
(rph/with-meta result {::audit/replace-props params})))))))
;; --- UPDATE FONT FAMILY
@ -128,10 +128,15 @@
[{:keys [pool] :as cfg} {:keys [team-id profile-id id name] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(db/update! conn :team-font-variant
{:font-family name}
{:font-id id
:team-id team-id})))
(rph/with-meta
(db/update! conn :team-font-variant
{:font-family name}
{:font-id id
:team-id team-id})
{::audit/replace-props {:id id
:name name
:team-id team-id
:profile-id profile-id}})))
;; --- DELETE FONT
@ -144,10 +149,14 @@
[{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:font-id id :team-id team-id})
nil))
(let [font (db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:font-id id :team-id team-id})]
(rph/with-meta (rph/wrap)
{::audit/props {:id id
:team-id team-id
:name (:font-family font)
:profile-id profile-id}}))))
;; --- DELETE FONT VARIANT
@ -160,8 +169,9 @@
[{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id id :team-id team-id})
nil))
(let [variant (db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id id :team-id team-id})]
(rph/with-meta (rph/wrap)
{::audit/props {:font-family (:font-family variant)
:font-id (:font-id variant)}}))))

58
backend/src/app/rpc/mutations/management.clj
View File

@ -1,58 +0,0 @@
;; 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.management
"Move & Duplicate RPC methods for files and projects."
(:require
[app.db :as db]
[app.rpc.commands.management :as cmd.mgm]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- MUTATION: Duplicate File
(s/def ::duplicate-file ::cmd.mgm/duplicate-file)
(sv/defmethod ::duplicate-file
{::doc/added "1.2"
::doc/deprecated "1.16"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.mgm/duplicate-file conn params)))
;; --- MUTATION: Duplicate Project
(s/def ::duplicate-project ::cmd.mgm/duplicate-project)
(sv/defmethod ::duplicate-project
{::doc/added "1.2"
::doc/deprecated "1.16"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.mgm/duplicate-project conn params)))
;; --- MUTATION: Move file
(s/def ::move-files ::cmd.mgm/move-files)
(sv/defmethod ::move-files
{::doc/added "1.2"
::doc/deprecated "1.16"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.mgm/move-files conn params)))
;; --- MUTATION: Move project
(s/def ::move-project ::cmd.mgm/move-project)
(sv/defmethod ::move-project
{::doc/added "1.2"
::doc/deprecated "1.16"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(cmd.mgm/move-project conn params)))

2
backend/src/app/rpc/mutations/media.clj
View File

@ -16,7 +16,7 @@
[app.http.client :as http]
[app.media :as media]
[app.rpc.climit :as climit]
[app.rpc.queries.teams :as teams]
[app.rpc.commands.teams :as teams]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.services :as sv]

12
backend/src/app/rpc/mutations/profile.clj
View File

@ -17,10 +17,10 @@
[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.auth :as auth]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile]
[app.storage :as sto]
[app.tokens :as tokens]
@ -111,7 +111,7 @@
(defn- validate-password!
[conn {:keys [profile-id old-password] :as params}]
(let [profile (db/get-by-id conn :profile profile-id)]
(when-not (:valid (cmd.auth/verify-password old-password (:password profile)))
(when-not (:valid (auth/verify-password old-password (:password profile)))
(ex/raise :type :validation
:code :old-password-not-match))
profile))
@ -119,7 +119,7 @@
(defn update-profile-password!
[conn {:keys [id password] :as profile}]
(db/update! conn :profile
{:password (cmd.auth/derive-password password)}
{:password (auth/derive-password password)}
{:id id}))
;; --- MUTATION: Update Photo
@ -182,7 +182,7 @@
(defn- change-email-immediately
[{:keys [conn]} {:keys [profile email] :as params}]
(when (not= email (:email profile))
(cmd.auth/check-profile-existence! conn params))
(auth/check-profile-existence! conn params))
(db/update! conn :profile
{:email email}
{:id (:id profile)})
@ -201,7 +201,7 @@
:exp (dt/in-future {:days 30})})]
(when (not= email (:email profile))
(cmd.auth/check-profile-existence! conn params))
(auth/check-profile-existence! conn params))
(when-not (eml/allow-send-emails? conn profile)
(ex/raise :type :validation

54
backend/src/app/rpc/mutations/projects.clj
View File

@ -7,15 +7,13 @@
(ns app.rpc.mutations.projects
(:require
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.queries.projects :as proj]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
@ -28,9 +26,7 @@
;; --- Mutation: Create Project
(declare create-project)
(declare create-project-role)
(declare create-team-project-profile)
(declare create-project-profile-state)
(s/def ::team-id ::us/uuid)
(s/def ::create-project
@ -43,33 +39,15 @@
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(let [project (create-project conn params)
(let [project (teams/create-project conn params)
params (assoc params
:project-id (:id project)
:role :owner)]
(create-project-role conn params)
(create-team-project-profile conn params)
(teams/create-project-role conn params)
(create-project-profile-state conn params)
(assoc project :is-pinned true))))
(defn create-project
[conn {:keys [id team-id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :project
{:id id
:name name
:team-id team-id
:is-default is-default})))
(defn create-project-role
[conn {:keys [project-id profile-id role]}]
(let [params {:project-id project-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :project-profile-rel))))
;; TODO: pending to be refactored
(defn create-team-project-profile
(defn create-project-profile-state
[conn {:keys [team-id project-id profile-id] :as params}]
(db/insert! conn :team-project-profile-rel
{:project-id project-id
@ -77,7 +55,6 @@
:team-id team-id
:is-pinned true}))
;; --- Mutation: Toggle Project Pin
(def ^:private
@ -94,13 +71,16 @@
(s/keys :req-un [::profile-id ::id ::team-id ::is-pinned]))
(sv/defmethod ::update-project-pin
{::doc/added "1.0"
::webhooks/batch-timeout (dt/duration "5s")
::webhooks/batch-key :id
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
(db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id)
(db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
nil))
;; --- Mutation: Rename Project
(declare rename-project)
@ -109,13 +89,19 @@
(s/keys :req-un [::profile-id ::name ::id]))
(sv/defmethod ::rename-project
{::doc/added "1.0"
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
(db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id)
(db/update! conn :project
{:name name}
{:id id})
nil))
(let [project (db/get-by-id conn :project id)]
(db/update! conn :project
{:name name}
{:id id})
(rph/with-meta (rph/wrap)
{::audit/props {:team-id (:team-id project)
:prev-name (:name project)}}))))
;; --- Mutation: Delete Project

441
backend/src/app/rpc/mutations/teams.clj
View File

@ -6,30 +6,19 @@
(ns app.rpc.mutations.teams
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.emails :as eml]
[app.loggers.audit :as audit]
[app.media :as media]
[app.rpc.climit :as climit]
[app.rpc.commands.teams :as cmd.teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.projects :as projects]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[promesa.core :as p]
[promesa.exec :as px]))
[cuerdas.core :as str]))
;; --- Helpers & Specs
@ -39,148 +28,54 @@
;; --- Mutation: Create Team
(declare create-team)
(declare create-team-entry)
(declare create-team-role)
(declare create-team-default-project)
(s/def ::create-team
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(s/def ::create-team ::cmd.teams/create-team)
(sv/defmethod ::create-team
[{:keys [pool] :as cfg} params]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(create-team conn params)))
(defn create-team
"This is a complete team creation process, it creates the team
object and all related objects (default role and default project)."
[conn params]
(let [team (create-team-entry conn params)
params (assoc params
:team-id (:id team)
:role :owner)
project (create-team-default-project conn params)]
(create-team-role conn params)
(assoc team :default-project-id (:id project))))
(defn- create-team-entry
[conn {:keys [id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :team
{:id id
:name name
:is-default is-default})))
(defn- create-team-role
[conn {:keys [team-id profile-id role] :as params}]
(let [params {:team-id team-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :team-profile-rel))))
(defn- create-team-default-project
[conn {:keys [team-id profile-id] :as params}]
(let [project {:id (uuid/next)
:team-id team-id
:name "Drafts"
:is-default true}
project (projects/create-project conn project)]
(projects/create-project-role conn {:project-id (:id project)
:profile-id profile-id
:role :owner})
project))
(cmd.teams/create-team conn params)))
;; --- Mutation: Update Team
(s/def ::update-team
(s/keys :req-un [::profile-id ::name ::id]))
(s/def ::update-team ::cmd.teams/update-team)
(sv/defmethod ::update-team
[{:keys [pool] :as cfg} {:keys [id name profile-id] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [id name profile-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id id)
(cmd.teams/check-edition-permissions! conn profile-id id)
(db/update! conn :team
{:name name}
{:id id})
nil))
;; --- Mutation: Leave Team
(declare role->params)
(s/def ::reassign-to ::us/uuid)
(s/def ::leave-team
(s/keys :req-un [::profile-id ::id]
:opt-un [::reassign-to]))
(s/def ::leave-team ::cmd.teams/leave-team)
(sv/defmethod ::leave-team
[{:keys [pool] :as cfg} {:keys [id profile-id reassign-to]}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id id)
members (teams/retrieve-team-members conn id)]
(cond
;; we can only proceed if there are more members in the team
;; besides the current profile
(<= (count members) 1)
(ex/raise :type :validation
:code :no-enough-members-for-leave
:context {:members (count members)})
;; if the `reassign-to` is filled and has a different value
;; than the current profile-id, we proceed to reassing the
;; owner role to profile identified by the `reassign-to`.
(and reassign-to (not= reassign-to profile-id))
(let [member (d/seek #(= reassign-to (:id %)) members)]
(when-not member
(ex/raise :type :not-found :code :member-does-not-exist))
;; unasign owner role to current profile
(db/update! conn :team-profile-rel
{:is-owner false}
{:team-id id
:profile-id profile-id})
;; assign owner role to new profile
(db/update! conn :team-profile-rel
(role->params :owner)
{:team-id id :profile-id reassign-to}))
;; and finally, if all other conditions does not match and the
;; current profile is owner, we dont allow it because there
;; must always be an owner.
(:is-owner perms)
(ex/raise :type :validation
:code :owner-cant-leave-team
:hint "releasing owner before leave"))
(db/delete! conn :team-profile-rel
{:profile-id profile-id
:team-id id})
nil)))
(cmd.teams/leave-team conn params)))
;; --- Mutation: Delete Team
(s/def ::delete-team
(s/keys :req-un [::profile-id ::id]))
;; TODO: right now just don't allow delete default team, in future it
;; should raise a specific exception for signal that this action is
;; not allowed.
(s/def ::delete-team ::cmd.teams/delete-team)
(sv/defmethod ::delete-team
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id id)]
(let [perms (cmd.teams/get-permissions conn profile-id id)]
(when-not (:is-owner perms)
(ex/raise :type :validation
:code :only-owner-can-delete-team))
(db/update! conn :team
{:deleted-at (dt/now)}
{:id id :is-default false})
@ -189,89 +84,29 @@
;; --- Mutation: Team Update Role
(declare retrieve-team-member)
(s/def ::team-id ::us/uuid)
(s/def ::member-id ::us/uuid)
;; Temporarily disabled viewer role
;; https://tree.taiga.io/project/uxboxproject/issue/1083
;; (s/def ::role #{:owner :admin :editor :viewer})
(s/def ::role #{:owner :admin :editor})
(s/def ::update-team-member-role
(s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
(s/def ::update-team-member-role ::cmd.teams/update-team-member-role)
(sv/defmethod ::update-team-member-role
[{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id team-id)
;; We retrieve all team members instead of query the
;; database for a single member. This is just for
;; convenience, if this becomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanisms.
members (teams/retrieve-team-members conn team-id)
member (d/seek #(= member-id (:id %)) members)
is-owner? (:is-owner perms)
is-admin? (:is-admin perms)]
;; If no member is found, just 404
(when-not member
(ex/raise :type :not-found
:code :member-does-not-exist))
;; First check if we have permissions to change roles
(when-not (or is-owner? is-admin?)
(ex/raise :type :validation
:code :insufficient-permissions))
;; Don't allow change role of owner member
(when (:is-owner member)
(ex/raise :type :validation
:code :cant-change-role-to-owner))
;; Don't allow promote to owner to admin users.
(when (and (not is-owner?) (= role :owner))
(ex/raise :type :validation
:code :cant-promote-to-owner))
(let [params (role->params role)]
;; Only allow single owner on team
(when (= role :owner)
(db/update! conn :team-profile-rel
{:is-owner false}
{:team-id team-id
:profile-id profile-id}))
(db/update! conn :team-profile-rel
params
{:team-id team-id
:profile-id member-id})
nil))))
(defn role->params
[role]
(case role
:admin {:is-owner false :is-admin true :can-edit true}
:editor {:is-owner false :is-admin false :can-edit true}
:owner {:is-owner true :is-admin true :can-edit true}
:viewer {:is-owner false :is-admin false :can-edit false}))
(cmd.teams/update-team-member-role conn params)))
;; --- Mutation: Delete Team Member
(s/def ::delete-team-member
(s/keys :req-un [::profile-id ::team-id ::member-id]))
(s/def ::delete-team-member ::cmd.teams/delete-team-member)
(sv/defmethod ::delete-team-member
[{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id team-id)]
(let [perms (cmd.teams/get-permissions conn profile-id team-id)]
(when-not (or (:is-owner perms)
(:is-admin perms))
(ex/raise :type :validation
:code :insufficient-permissions))
(when (= member-id profile-id)
(ex/raise :type :validation
:code :cant-remove-yourself))
@ -283,85 +118,27 @@
;; --- Mutation: Update Team Photo
(declare ^:private upload-photo)
(declare ^:private update-team-photo)
(s/def ::file ::media/upload)
(s/def ::update-team-photo
(s/keys :req-un [::profile-id ::team-id ::file]))
(s/def ::update-team-photo ::cmd.teams/update-team-photo)
(sv/defmethod ::update-team-photo
{::doc/added "1.0"
::doc/deprecated "1.17"}
[cfg {:keys [file] :as params}]
;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
(let [cfg (update cfg :storage media/configure-assets-storage)]
(update-team-photo cfg params)))
(defn update-team-photo
[{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
(p/let [team (px/with-dispatch executor
(teams/retrieve-team pool profile-id team-id))
photo (upload-photo cfg params)]
;; Mark object as touched for make it ellegible for tentative
;; garbage collection.
(when-let [id (:photo-id team)]
(sto/touch-object! storage id))
;; Save new photo
(db/update! pool :team
{:photo-id (:id photo)}
{:id team-id})
(assoc team :photo-id (:id photo))))
(defn upload-photo
[{:keys [storage 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)}))))
(cmd.teams/update-team-photo cfg params)))
;; --- Mutation: Invite Member
(declare create-team-invitation)
(s/def ::email ::us/email)
(s/def ::emails ::us/set-of-valid-emails)
(s/def ::invite-team-member
(s/keys :req-un [::profile-id ::team-id ::role]
:opt-un [::email ::emails]))
(s/def ::invite-team-member ::cmd.teams/create-team-invitations)
(sv/defmethod ::invite-team-member
"A rpc call that allow to send a single or multiple invitations to
join the team."
[{:keys [pool] :as cfg} {:keys [profile-id team-id email emails role] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email emails role] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id team-id)
(let [perms (cmd.teams/get-permissions conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
team (db/get-by-id conn :team team-id)
emails (cond-> (or emails #{}) (string? email) (conj email))]
@ -376,115 +153,38 @@
:code :profile-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
(let [invitations (->> emails
(let [cfg (assoc cfg ::cmd.teams/conn conn)
invitations (->> emails
(map (fn [email]
(assoc cfg
:email email
:conn conn
:team team
:profile profile
:role role)))
(map create-team-invitation))]
{:email (str/lower email)
:team team
:profile profile
:role role}))
(map (partial #'cmd.teams/create-invitation cfg)))]
(with-meta (vec invitations)
{::audit/props {:invitations (count invitations)}})))))
(def sql:upsert-team-invitation
"insert into team_invitation(team_id, email_to, role, valid_until)
values (?, ?, ?, ?)
on conflict(team_id, email_to) do
update set role = ?, valid_until = ?, updated_at = now();")
(defn- create-team-invitation
[{:keys [conn sprops team profile role email] :as cfg}]
(let [member (profile/retrieve-profile-data-by-email conn email)
token-exp (dt/in-future "168h") ;; 7 days
email (str/lower email)
itoken (tokens/generate sprops
{:iss :team-invitation
:exp token-exp
:profile-id (:id profile)
:role role
:team-id (:id team)
:member-email (:email member email)
:member-id (:id member)})
ptoken (tokens/generate sprops
{:iss :profile-identity
:profile-id (:id profile)
:exp (dt/in-future {:days 30})})]
(when (and member (not (eml/allow-send-emails? conn member)))
(ex/raise :type :validation
:code :member-is-muted
:email email
:hint "the profile has reported repeatedly as spam or has bounces"))
;; Secondly check if the invited member email is part of the global spam/bounce report.
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
:code :email-has-permanent-bounces
:email email
:hint "the email you invite has been repeatedly reported as spam or bounce"))
(when (contains? cf/flags :log-invitation-tokens)
(l/trace :hint "invitation token" :token itoken))
;; When we have email verification disabled and invitation user is
;; already present in the database, we proceed to add it to the
;; team as-is, without email roundtrip.
;; TODO: if member does not exists and email verification is
;; disabled, we should proceed to create the profile (?)
(if (and (not (contains? cf/flags :email-verification))
(some? member))
(let [params (merge {:team-id (:id team)
:profile-id (:id member)}
(role->params role))]
;; Insert the invited member to the team
(db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
;; If profile is not yet verified, mark it as verified because
;; accepting an invitation link serves as verification.
(when-not (:is-active member)
(db/update! conn :profile
{:is-active true}
{:id (:id member)})))
(do
(db/exec-one! conn [sql:upsert-team-invitation
(:id team) (str/lower email) (name role)
token-exp (name role) token-exp])
(eml/send! {::eml/conn conn
::eml/factory eml/invite-to-team
:public-uri (:public-uri cfg)
:to email
:invited-by (:fullname profile)
:team (:name team)
:token itoken
:extra-data ptoken})))
itoken))
;; --- Mutation: Create Team & Invite Members
(s/def ::emails ::us/set-of-valid-emails)
(s/def ::create-team-and-invite-members
(s/and ::create-team (s/keys :req-un [::emails ::role])))
(s/def ::create-team-and-invite-members ::cmd.teams/create-team-with-invitations)
(sv/defmethod ::create-team-and-invite-members
[{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id emails role] :as params}]
(db/with-atomic [conn pool]
(let [team (create-team conn params)
profile (db/get-by-id conn :profile profile-id)]
(let [team (cmd.teams/create-team conn params)
profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg ::cmd.teams/conn conn)]
;; Create invitations for all provided emails.
(doseq [email emails]
(create-team-invitation
(assoc cfg
:conn conn
:team team
:profile profile
:email email
:role role)))
(->> emails
(map (fn [email]
{:team team
:profile profile
:email (str/lower email)
:role role}))
(run! (partial #'cmd.teams/create-invitation cfg)))
(-> team
(vary-meta assoc ::audit/props {:invitations (count emails)})
@ -505,9 +205,11 @@
(s/keys :req-un [::profile-id ::team-id ::email ::role]))
(sv/defmethod ::update-team-invitation-role
[{:keys [pool] :as cfg} {:keys [profile-id team-id email role] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email role] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id team-id)]
(let [perms (cmd.teams/get-permissions conn profile-id team-id)]
(when-not (:is-admin perms)
(ex/raise :type :validation
@ -520,13 +222,14 @@
;; --- Mutation: Delete invitation
(s/def ::delete-team-invitation
(s/keys :req-un [::profile-id ::team-id ::email]))
(s/def ::delete-team-invitation ::cmd.teams/delete-team-invitation)
(sv/defmethod ::delete-team-invitation
[{:keys [pool] :as cfg} {:keys [profile-id team-id email] :as params}]
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/get-permissions conn profile-id team-id)]
(let [perms (cmd.teams/get-permissions conn profile-id team-id)]
(when-not (:is-admin perms)
(ex/raise :type :validation

28
backend/src/app/rpc/mutations/verify_token.clj
View File

@ -1,28 +0,0 @@
;; 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.verify-token
(:require
[app.db :as db]
[app.rpc.commands.verify-token :refer [process-token]]
[app.rpc.doc :as-alias doc]
[app.tokens :as tokens]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
(s/def ::verify-token
(s/keys :req-un [::token]
:opt-un [::profile-id]))
(sv/defmethod ::verify-token
{:auth false
::doc/added "1.1"
::doc/deprecated "1.15"}
[{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
(db/with-atomic [conn pool]
(let [claims (tokens/verify sprops {:token token})
cfg (assoc cfg :conn conn)]
(process-token cfg params claims))))

82
backend/src/app/rpc/queries/comments.clj
View File

@ -1,82 +0,0 @@
;; 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.queries.comments
(:require
[app.db :as db]
[app.rpc.commands.comments :as cmd.comments]
[app.rpc.commands.files :as cmd.files]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
(defn decode-row
[{:keys [participants position] :as row}]
(cond-> row
(db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
(db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
;; --- QUERY: Comment Threads
(s/def ::comment-threads ::cmd.comments/get-comment-threads)
(sv/defmethod ::comment-threads
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} params]
(with-open [conn (db/open pool)]
(cmd.comments/retrieve-comment-threads conn params)))
;; --- QUERY: Unread Comment Threads
(s/def ::unread-comment-threads ::cmd.comments/get-unread-comment-threads)
(sv/defmethod ::unread-comment-threads
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(cmd.comments/retrieve-unread-comment-threads conn params)))
;; --- QUERY: Single Comment Thread
(s/def ::comment-thread ::cmd.comments/get-comment-thread)
(sv/defmethod ::comment-thread
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
(with-open [conn (db/open pool)]
(cmd.files/check-comment-permissions! conn profile-id file-id share-id)
(cmd.comments/get-comment-thread conn params)))
;; --- QUERY: Comments
(s/def ::comments ::cmd.comments/get-comments)
(sv/defmethod ::comments
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id thread-id share-id] :as params}]
(with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)]
(cmd.files/check-comment-permissions! conn profile-id (:file-id thread) share-id))
(cmd.comments/get-comments conn thread-id)))
;; --- QUERY: Get file comments users
(s/def ::file-comments-users ::cmd.comments/get-profiles-for-file-comments)
(sv/defmethod ::file-comments-users
{::doc/deprecated "1.15"
::doc/added "1.13"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}]
(with-open [conn (db/open pool)]
(cmd.files/check-comment-permissions! conn profile-id file-id share-id)
(cmd.comments/get-file-comments-users conn file-id profile-id)))

68
backend/src/app/rpc/queries/files.clj
View File

@ -8,38 +8,38 @@
(:require
[app.common.spec :as us]
[app.db :as db]
[app.rpc.commands.files :as cmd.files]
[app.rpc.commands.search :as cmd.search]
[app.rpc.commands.files :as files]
[app.rpc.commands.search :as search]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.projects :as projects]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Query: Project Files
(s/def ::project-files ::cmd.files/get-project-files)
(s/def ::project-files ::files/get-project-files)
(sv/defmethod ::project-files
{::doc/added "1.1"
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
(with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id)
(cmd.files/get-project-files conn project-id)))
(files/get-project-files conn project-id)))
;; --- Query: File (By ID)
(s/def ::components-v2 ::us/boolean)
(s/def ::file
(s/and ::cmd.files/get-file
(s/and ::files/get-file
(s/keys :opt-un [::components-v2])))
(defn get-file
[conn id features]
(let [file (cmd.files/get-file conn id features)
thumbs (cmd.files/get-object-thumbnails conn id)]
(let [file (files/get-file conn id features)
thumbs (files/get-object-thumbnails conn id)]
(assoc file :thumbnails thumbs)))
(sv/defmethod ::file
@ -48,19 +48,19 @@
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id id features components-v2] :as params}]
(with-open [conn (db/open pool)]
(let [perms (cmd.files/get-permissions pool profile-id id)
(let [perms (files/get-permissions pool profile-id id)
;; BACKWARD COMPATIBILTY with the components-v2 parameter
features (cond-> (or features #{})
components-v2 (conj "components/v2"))]
(cmd.files/check-read-permissions! perms)
(files/check-read-permissions! perms)
(-> (get-file conn id features)
(assoc :permissions perms)))))
;; --- QUERY: page
(s/def ::page
(s/and ::cmd.files/get-page
(s/and ::files/get-page
(s/keys :opt-un [::components-v2])))
(sv/defmethod ::page
@ -77,18 +77,18 @@
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as params}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(files/check-read-permissions! conn profile-id file-id)
(let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
features (cond-> (or features #{})
components-v2 (conj "components/v2"))
params (assoc params :features features)]
(cmd.files/get-page conn params))))
(files/get-page conn params))))
;; --- QUERY: file-data-for-thumbnail
(s/def ::file-data-for-thumbnail
(s/and ::cmd.files/get-file-data-for-thumbnail
(s/and ::files/get-file-data-for-thumbnail
(s/keys :opt-un [::components-v2])))
(sv/defmethod ::file-data-for-thumbnail
@ -98,18 +98,18 @@
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as props}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(files/check-read-permissions! conn profile-id file-id)
(let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
features (cond-> (or features #{})
components-v2 (conj "components/v2"))
file (cmd.files/get-file conn file-id features)]
file (files/get-file conn file-id features)]
{:file-id file-id
:revn (:revn file)
:page (cmd.files/get-file-data-for-thumbnail conn file)})))
:page (files/get-file-data-for-thumbnail conn file)})))
;; --- Query: Shared Library Files
(s/def ::team-shared-files ::cmd.files/get-team-shared-files)
(s/def ::team-shared-files ::files/get-team-shared-files)
(sv/defmethod ::team-shared-files
{::doc/added "1.3"
@ -117,37 +117,37 @@
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(cmd.files/get-team-shared-files conn params)))
(files/get-team-shared-files conn params)))
;; --- Query: File Libraries used by a File
(s/def ::file-libraries ::cmd.files/get-file-libraries)
(s/def ::file-libraries ::files/get-file-libraries)
(sv/defmethod ::file-libraries
{::doc/added "1.3"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(cmd.files/get-file-libraries conn file-id features)))
(files/check-read-permissions! conn profile-id file-id)
(files/get-file-libraries conn file-id features)))
;; --- Query: Files that use this File library
(s/def ::library-using-files ::cmd.files/get-library-file-references)
(s/def ::library-using-files ::files/get-library-file-references)
(sv/defmethod ::library-using-files
{::doc/added "1.13"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(cmd.files/get-library-file-references conn file-id)))
(files/check-read-permissions! conn profile-id file-id)
(files/get-library-file-references conn file-id)))
;; --- QUERY: team-recent-files
(s/def ::team-recent-files ::cmd.files/get-team-recent-files)
(s/def ::team-recent-files ::files/get-team-recent-files)
(sv/defmethod ::team-recent-files
{::doc/added "1.0"
@ -155,30 +155,30 @@
[{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(cmd.files/get-team-recent-files conn team-id)))
(files/get-team-recent-files conn team-id)))
;; --- QUERY: get file thumbnail
(s/def ::file-thumbnail ::cmd.files/get-file-thumbnail)
(s/def ::file-thumbnail ::files/get-file-thumbnail)
(sv/defmethod ::file-thumbnail
{::doc/added "1.13"
::doc/deprecated "1.17"}
[{:keys [pool]} {:keys [profile-id file-id revn]}]
(with-open [conn (db/open pool)]
(cmd.files/check-read-permissions! conn profile-id file-id)
(-> (cmd.files/get-file-thumbnail conn file-id revn)
(rph/with-http-cache cmd.files/long-cache-duration))))
(files/check-read-permissions! conn profile-id file-id)
(-> (files/get-file-thumbnail conn file-id revn)
(rph/with-http-cache files/long-cache-duration))))
;; --- QUERY: search files
(s/def ::search-files ::cmd.search/search-files)
(s/def ::search-files ::search/search-files)
(sv/defmethod ::search-files
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool]} {:keys [search-term] :as params}]
(when search-term
(cmd.search/search-files pool params)))
(search/search-files pool params)))

21
backend/src/app/rpc/queries/fonts.clj
View File

@ -9,28 +9,12 @@
[app.common.spec :as us]
[app.db :as db]
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.projects :as projects]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Query: Team Font Variants
;; TODO: deprecated, should be removed on 1.7.x
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::team-font-variants
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::team-font-variants
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(db/query conn :team-font-variant
{:team-id team-id
:deleted-at nil})))
;; --- Query: Font Variants
(s/def ::file-id ::us/uuid)
@ -47,6 +31,7 @@
(contains? o :project-id)))))
(sv/defmethod ::font-variants
{::doc/added "1.7"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id file-id project-id] :as params}]
(with-open [conn (db/open pool)]
(cond

2
backend/src/app/rpc/queries/projects.clj
View File

@ -8,8 +8,8 @@
(:require
[app.common.spec :as us]
[app.db :as db]
[app.rpc.commands.teams :as teams]
[app.rpc.permissions :as perms]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))

228
backend/src/app/rpc/queries/teams.clj
View File

@ -6,244 +6,82 @@
(ns app.rpc.queries.teams
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.rpc.commands.teams :as cmd.teams]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Team Edition Permissions
(def ^:private sql:team-permissions
"select tpr.is_owner,
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
join team as t on (t.id = tpr.team_id)
where tpr.profile_id = ?
and tpr.team_id = ?
and t.deleted_at is null")
(defn get-permissions
[conn profile-id team-id]
(let [rows (db/exec! conn [sql:team-permissions profile-id team-id])
is-owner (boolean (some :is-owner rows))
is-admin (boolean (some :is-admin rows))
can-edit (boolean (some :can-edit rows))]
(when (seq rows)
{:is-owner is-owner
:is-admin (or is-owner is-admin)
:can-edit (or is-owner is-admin can-edit)
:can-read true})))
(def has-edit-permissions?
(perms/make-edition-predicate-fn get-permissions))
(def has-read-permissions?
(perms/make-read-predicate-fn get-permissions))
(def check-edition-permissions!
(perms/make-check-fn has-edit-permissions?))
(def check-read-permissions!
(perms/make-check-fn has-read-permissions?))
;; --- Query: Teams
(declare retrieve-teams)
(s/def ::profile-id ::us/uuid)
(s/def ::teams
(s/keys :req-un [::profile-id]))
(s/def ::teams ::cmd.teams/get-teams)
(sv/defmethod ::teams
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id]}]
(with-open [conn (db/open pool)]
(retrieve-teams conn profile-id)))
(def sql:teams
"select t.*,
tp.is_owner,
tp.is_admin,
tp.can_edit,
(t.id = ?) as is_default
from team_profile_rel as tp
join team as t on (t.id = tp.team_id)
where t.deleted_at is null
and tp.profile_id = ?
order by tp.created_at asc")
(defn process-permissions
[team]
(let [is-owner (:is-owner team)
is-admin (:is-admin team)
can-edit (:can-edit team)
permissions {:type :membership
:is-owner is-owner
:is-admin (or is-owner is-admin)
:can-edit (or is-owner is-admin can-edit)}]
(-> team
(dissoc :is-owner :is-admin :can-edit)
(assoc :permissions permissions))))
(defn retrieve-teams
[conn profile-id]
(let [defaults (profile/retrieve-additional-data conn profile-id)]
(->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id])
(mapv process-permissions))))
(cmd.teams/retrieve-teams conn profile-id)))
;; --- Query: Team (by ID)
(declare retrieve-team)
(s/def ::id ::us/uuid)
(s/def ::team
(s/keys :req-un [::profile-id ::id]))
(s/def ::team ::cmd.teams/get-team)
(sv/defmethod ::team
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id id]}]
(with-open [conn (db/open pool)]
(retrieve-team conn profile-id id)))
(defn retrieve-team
[conn profile-id team-id]
(let [defaults (profile/retrieve-additional-data conn profile-id)
sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
result (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])]
(when-not result
(ex/raise :type :not-found
:code :team-does-not-exist))
(process-permissions result)))
(cmd.teams/retrieve-team conn profile-id id)))
;; --- Query: Team Members
(declare retrieve-team-members)
(s/def ::team-id ::us/uuid)
(s/def ::team-members
(s/keys :req-un [::profile-id ::team-id]))
(s/def ::team-members ::cmd.teams/get-team-members)
(sv/defmethod ::team-members
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id)))
(def sql:team-members
"select tp.*,
p.id,
p.email,
p.fullname as name,
p.fullname as fullname,
p.photo_id,
p.is_active
from team_profile_rel as tp
join profile as p on (p.id = tp.profile_id)
where tp.team_id = ?")
(defn retrieve-team-members
[conn team-id]
(db/exec! conn [sql:team-members team-id]))
(cmd.teams/check-read-permissions! conn profile-id team-id)
(cmd.teams/retrieve-team-members conn team-id)))
;; --- Query: Team Users
(declare retrieve-users)
(declare retrieve-team-for-file)
(s/def ::file-id ::us/uuid)
(s/def ::team-users
(s/and (s/keys :req-un [::profile-id]
:opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %))))
(s/def ::team-users ::cmd.teams/get-team-users)
(sv/defmethod ::team-users
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
(with-open [conn (db/open pool)]
(if team-id
(do
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id))
(let [{team-id :id} (retrieve-team-for-file conn file-id)]
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id)))))
;; This is a similar query to team members but can contain more data
;; because some user can be explicitly added to project or file (not
;; implemented in UI)
(def sql:team-users
"select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
where tpr.team_id = ?
union
select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
inner join project as p on (ppr.project_id = p.id)
where p.team_id = ?
union
select pf.id, pf.fullname, pf.photo_id
from profile as pf
inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
inner join file as f on (fpr.file_id = f.id)
inner join project as p on (f.project_id = p.id)
where p.team_id = ?")
(def sql:team-by-file
"select p.team_id as id
from project as p
join file as f on (p.id = f.project_id)
where f.id = ?")
(defn retrieve-users
[conn team-id]
(db/exec! conn [sql:team-users team-id team-id team-id]))
(defn retrieve-team-for-file
[conn file-id]
(->> [sql:team-by-file file-id]
(db/exec-one! conn)))
(cmd.teams/check-read-permissions! conn profile-id team-id)
(cmd.teams/retrieve-users conn team-id))
(let [{team-id :id} (cmd.teams/retrieve-team-for-file conn file-id)]
(cmd.teams/check-read-permissions! conn profile-id team-id)
(cmd.teams/retrieve-users conn team-id)))))
;; --- Query: Team Stats
(declare retrieve-team-stats)
(s/def ::team-stats
(s/keys :req-un [::profile-id ::team-id]))
(s/def ::team-stats ::cmd.teams/get-team-stats)
(sv/defmethod ::team-stats
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id)))
(def sql:team-stats
"select (select count(*) from project where team_id = ?) as projects,
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
(defn retrieve-team-stats
[conn team-id]
(db/exec-one! conn [sql:team-stats team-id team-id]))
(cmd.teams/check-read-permissions! conn profile-id team-id)
(cmd.teams/retrieve-team-stats conn team-id)))
;; --- Query: Team invitations
(s/def ::team-id ::us/uuid)
(s/def ::team-invitations
(s/keys :req-un [::profile-id ::team-id]))
(def sql:team-invitations
"select email_to as email, role, (valid_until < now()) as expired
from team_invitation where team_id = ? order by valid_until desc")
(s/def ::team-invitations ::cmd.teams/get-team-invitations)
(sv/defmethod ::team-invitations
{::doc/added "1.0"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(->> (db/exec! conn [sql:team-invitations team-id])
(mapv #(update % :role keyword)))))
(cmd.teams/check-read-permissions! conn profile-id team-id)
(cmd.teams/get-team-invitations conn team-id)))

20
backend/src/app/rpc/retry.clj
View File

@ -5,23 +5,23 @@
;; Copyright (c) KALEIDOS INC
(ns app.rpc.retry
"A fault tolerance helpers. Allow retry some operations that we know
we can retry."
"A fault tolerance RPC middleware. Allow retry some operations that we
know we can retry."
(:require
[app.common.logging :as l]
[app.util.retry :refer [conflict-exception?]]
[app.util.services :as sv]
[promesa.core :as p]))
(defn conflict-db-insert?
"Check if exception matches a insertion conflict on postgresql."
[e]
(and (instance? org.postgresql.util.PSQLException e)
(= "23505" (.getSQLState e))))
(conflict-exception? e))
(def always-false (constantly false))
(defn wrap-retry
[_ f {:keys [::matches ::sv/name]
:or {matches (constantly false)}
:as mdata}]
[_ f {:keys [::matches ::sv/name] :or {matches always-false} :as mdata}]
(when (::enabled mdata)
(l/debug :hint "wrapping retry" :name name))
@ -29,8 +29,8 @@
(if-let [max-retries (::max-retries mdata)]
(fn [cfg params]
(letfn [(run [retry]
(-> (f cfg params)
(p/catch (partial handle-error retry))))
(->> (f cfg params)
(p/merr (partial handle-error retry))))
(handle-error [retry cause]
(if (matches cause)
@ -40,6 +40,6 @@
(run current-retry)
(throw cause)))
(throw cause)))]
(run 0)))
(run 1)))
f))

34
backend/src/app/util/retry.clj Normal file
View File

@ -0,0 +1,34 @@
;; 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.util.retry
"A fault tolerance helpers. Allow retry some operations that we know
we can retry."
(:require
[app.common.logging :as l])
(:import
org.postgresql.util.PSQLException))
(defn conflict-exception?
"Check if exception matches a insertion conflict on postgresql."
[e]
(and (instance? PSQLException e)
(= "23505" (.getSQLState ^PSQLException e))))
(defmacro with-retry
[{:keys [::when ::max-retries ::label] :or {max-retries 3}} & body]
`(loop [tnum# 1]
(let [result# (try
~@body
(catch Throwable cause#
(if (and (~when cause#) (<= tnum# ~max-retries))
::retry
(throw cause#))))]
(if (= ::retry result#)
(do
(l/warn :hint "retrying operation" :label ~label)
(recur (inc tnum#)))
result#))))

9
backend/src/app/worker.clj
View File

@ -217,7 +217,7 @@
(l/debug :hist "dispatcher: queue tasks"
:queue queue
:tasks (count ids)
:total-queued res)))
:queued res)))
(run-batch! [rconn]
(db/with-atomic [conn pool]
@ -446,10 +446,11 @@
:else
(try
(l/debug :hint "worker: executing task"
:name (:name task)
:id (:id task)
:queue queue
:worker-id worker-id
:task-id (:id task)
:task-name (:name task)
:task-retry (:retry-num task))
:retry (:retry-num task))
(handle-task task)
(catch InterruptedException cause
(throw cause))

9
backend/test/backend_tests/helpers.clj
View File

@ -17,14 +17,13 @@
[app.main :as main]
[app.media]
[app.migrations]
[app.rpc.helpers :as rph]
[app.rpc.commands.auth :as cmd.auth]
[app.rpc.commands.files :as files]
[app.rpc.commands.files.create :as files.create]
[app.rpc.commands.files.update :as files.update]
[app.rpc.commands.teams :as teams]
[app.rpc.helpers :as rph]
[app.rpc.mutations.profile :as profile]
[app.rpc.mutations.projects :as projects]
[app.rpc.mutations.teams :as teams]
[app.util.blob :as blob]
[app.util.services :as sv]
[app.util.time :as dt]
@ -172,7 +171,7 @@
(->> (merge {:id (mk-uuid "project" i)
:name (str "project" i)}
params)
(#'projects/create-project conn)))))
(#'teams/create-project conn)))))
(defn create-file*
([i params]
@ -254,7 +253,7 @@
([params] (create-project-role* *pool* params))
([pool {:keys [project-id profile-id role] :or {role :owner}}]
(with-open [conn (db/open pool)]
(#'projects/create-project-role conn {:project-id project-id
(#'teams/create-project-role conn {:project-id project-id
:profile-id profile-id
:role role}))))

18
backend/test/backend_tests/rpc_management_test.clj
View File

@ -53,7 +53,7 @@
:profile-id (:id profile)
:file-id (:id file1)
:name "file 1 (copy)"}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
@ -125,7 +125,7 @@
:profile-id (:id profile)
:file-id (:id file1)
:name "file 1 (copy)"}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
@ -187,7 +187,7 @@
:profile-id (:id profile)
:project-id (:id project)
:name "project 1 (copy)"}
out (th/mutation! data)]
out (th/command! data)]
;; Check that result is correct
(t/is (nil? (:error out)))
@ -253,7 +253,7 @@
:profile-id (:id profile)
:project-id (:id project)
:name "project 1 (copy)"}
out (th/mutation! data)]
out (th/command! data)]
;; Check that result is correct
(t/is (nil? (:error out)))
@ -317,7 +317,7 @@
:project-id (:id project1)
:ids #{(:id file1)}}
out (th/mutation! data)
out (th/command! data)
error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
@ -337,7 +337,7 @@
:project-id (:id project2)
:ids #{(:id file1)}}
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
@ -419,7 +419,7 @@
:profile-id (:id profile)
:project-id (:id project2)
:ids #{(:id file1)}}
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
@ -492,7 +492,7 @@
:profile-id (:id profile)
:project-id (:id project2)
:ids #{(:id file2)}}
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
@ -578,7 +578,7 @@
:profile-id (:id profile)
:project-id (:id project1)
:team-id (:id team)}
out (th/mutation! data)]
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))

18
backend/test/backend_tests/rpc_team_test.clj
View File

@ -63,6 +63,16 @@
(t/is (th/success? out))
(t/is (= 1 (:call-count (deref mock)))))
;; get invitation token
(let [params {::th/type :get-team-invitation-token
:profile-id (:id profile1)
:team-id (:id team)
:email "foo@bar.com"}
out (th/command! params)]
(t/is (th/success? out))
(let [result (:result out)]
(contains? result :token)))
;; invite user with bounce
(th/reset-mock! mock)
@ -179,7 +189,7 @@
:valid-until (dt/in-future "48h")})
(let [data {::th/type :verify-token :token token}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
@ -205,7 +215,7 @@
:valid-until (dt/in-future "48h")})
(let [data {::th/type :verify-token :token token :profile-id (:id profile2)}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
@ -226,7 +236,7 @@
:valid-until (dt/in-future "48h")})
(let [data {::th/type :verify-token :token token :profile-id (:id profile1)}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
@ -235,8 +245,6 @@
)))
(t/deftest invite-team-member-with-email-verification-disabled
(with-mocks [mock {:target 'app.emails/send! :return nil}]
(let [profile1 (th/create-profile* 1 {:is-active true})

5
common/src/app/common/logging.cljc
View File

@ -44,8 +44,9 @@
(defn build-message-cause
[props]
#?(:clj (when-let [[_ cause] (d/seek (fn [[k]] (= k :cause)) props)]
(with-out-str
(ex/print-throwable cause)))
(when cause
(with-out-str
(ex/print-throwable cause))))
:cljs nil))
(defn build-message

2
common/src/app/common/spec.cljc
View File

@ -135,7 +135,7 @@
(letfn [(conformer [s]
(cond
(u/uri? s) s
(string? s) (u/uri s)
(string? s) (u/uri (str/trim s))
:else ::s/invalid))
(unformer [v]
(dm/str v))]

8
frontend/resources/styles/main/partials/dashboard-team.scss
View File

@ -199,10 +199,12 @@
}
}
&.uri,
&.uri {
flex-grow: 1;
}
&.active {
width: 48%;
min-width: 300px;
min-width: 100px;
}
&.last-delivery {

1
frontend/src/app/main.cljs
View File

@ -60,6 +60,7 @@
(rx/merge
(rx/of (ev/initialize)
(du/initialize-profile))
(->> stream
(rx/filter du/profile-fetched?)
(rx/take 1)

65
frontend/src/app/main/data/dashboard.cljs
View File

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.events :as ev]
[app.main.data.fonts :as df]
[app.main.data.media :as di]
@ -18,6 +19,7 @@
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.timers :as tm]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
@ -110,7 +112,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query! :team-members {:team-id team-id})
(->> (rp/cmd! :get-team-members {:team-id team-id})
(rx/map team-members-fetched))))))
;; --- EVENT: fetch-team-stats
@ -128,7 +130,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query! :team-stats {:team-id team-id})
(->> (rp/cmd! :get-team-stats {:team-id team-id})
(rx/map team-stats-fetched))))))
;; --- EVENT: fetch-team-invitations
@ -146,7 +148,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query! :team-invitations {:team-id team-id})
(->> (rp/cmd! :get-team-invitations {:team-id team-id})
(rx/map team-invitations-fetched))))))
;; --- EVENT: fetch-team-webhooks
@ -384,14 +386,13 @@
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
(->> (rp/mutation! :create-team {:name name})
(->> (rp/cmd! :create-team {:name name})
(rx/tap on-success)
(rx/map team-created)
(rx/catch on-error))))))
;; --- EVENT: create-team-with-invitations
(defn create-team-with-invitations
[{:keys [name emails role] :as params}]
(us/assert! ::us/string name)
@ -404,7 +405,7 @@
params {:name name
:emails #{emails}
:role role}]
(->> (rp/mutation! :create-team-and-invite-members params)
(->> (rp/cmd! :create-team-with-invitations params)
(rx/tap on-success)
(rx/map team-created)
(rx/catch on-error))))))
@ -421,7 +422,7 @@
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation! :update-team params)
(->> (rp/cmd! :update-team params)
(rx/ignore)))))
(defn update-team-photo
@ -440,7 +441,7 @@
(->> (rx/of file)
(rx/map di/validate-file)
(rx/map prepare)
(rx/mapcat #(rp/mutation :update-team-photo %))
(rx/mapcat #(rp/cmd! :update-team-photo %))
(rx/do on-success)
(rx/map du/fetch-teams)
(rx/catch on-error))))))
@ -454,7 +455,7 @@
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)]
(->> (rp/mutation! :update-team-member-role params)
(->> (rp/cmd! :update-team-member-role params)
(rx/mapcat (fn [_]
(rx/of (fetch-team-members)
(du/fetch-teams)))))))))
@ -467,7 +468,7 @@
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)]
(->> (rp/mutation! :delete-team-member params)
(->> (rp/cmd! :delete-team-member params)
(rx/mapcat (fn [_]
(rx/of (fetch-team-members)
(du/fetch-teams)))))))))
@ -487,7 +488,7 @@
params (cond-> {:id team-id}
(uuid? reassign-to)
(assoc :reassign-to reassign-to))]
(->> (rp/mutation! :leave-team params)
(->> (rp/cmd! :leave-team params)
(rx/tap #(tm/schedule on-success))
(rx/catch on-error))))))
@ -506,10 +507,40 @@
:or {on-success identity
on-error rx/throw}} (meta params)
params (dissoc params :resend?)]
(->> (rp/mutation! :invite-team-member params)
(->> (rp/cmd! :create-team-invitations params)
(rx/tap on-success)
(rx/catch on-error))))))
(defn copy-invitation-link
[{:keys [email team-id] :as params}]
(us/assert! ::us/email email)
(us/assert! ::us/uuid team-id)
(ptk/reify ::copy-invitation-link
IDeref
(-deref [_] {:email email :team-id team-id})
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
router (:router state)]
(->> (rp/cmd! :get-team-invitation-token params)
(rx/map (fn [params]
(rt/resolve router :auth-verify-token {} params)))
(rx/map (fn [fragment]
(assoc @cf/public-uri :fragment fragment)))
(rx/tap (fn [uri]
(wapi/write-to-clipboard (str uri))))
(rx/tap on-success)
(rx/ignore)
(rx/catch on-error))))))
(defn update-team-invitation-role
[{:keys [email team-id role] :as params}]
(us/assert! ::us/email email)
@ -524,7 +555,7 @@
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
(->> (rp/mutation! :update-team-invitation-role params)
(->> (rp/cmd! :update-team-invitation-role params)
(rx/tap on-success)
(rx/catch on-error))))))
@ -538,7 +569,7 @@
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
(->> (rp/mutation! :delete-team-invitation params)
(->> (rp/cmd! :delete-team-invitation params)
(rx/tap on-success)
(rx/catch on-error))))))
@ -589,7 +620,9 @@
ptk/WatchEvent
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)
params (-> params
(assoc :team-id team-id)
(update :uri str))
{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
@ -608,7 +641,7 @@
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
(->> (rp/mutation! :delete-team {:id id})
(->> (rp/cmd! :delete-team {:id id})
(rx/tap on-success)
(rx/catch on-error))))))

5
frontend/src/app/main/data/users.cljs
View File

@ -87,7 +87,7 @@
(ptk/reify ::fetch-teams
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query! :teams)
(->> (rp/cmd! :get-teams)
(rx/map teams-fetched)))))
;; --- EVENT: fetch-profile
@ -164,6 +164,7 @@
(swap! storage dissoc :redirect-url)
(.replace js/location redirect-url))
(rt/nav' :dashboard-projects {:team-id team-id}))))]
(ptk/reify ::logged-in
IDeref
(-deref [_] profile)
@ -445,7 +446,7 @@
(ptk/reify ::fetch-team-users
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query! :team-users {:team-id team-id})
(->> (rp/cmd! :get-team-users {:team-id team-id})
(rx/map #(partial fetched %)))))))
(defn fetch-file-comments-users

2
frontend/src/app/main/data/workspace.cljs
View File

@ -265,7 +265,7 @@
(->> (rx/zip (rp/cmd! :get-file {:id file-id :features features})
(rp/cmd! :get-file-object-thumbnails {:file-id file-id})
(rp/query! :project {:id project-id})
(rp/query! :team-users {:file-id file-id})
(rp/cmd! :get-team-users {:file-id file-id})
(rp/cmd! :get-profiles-for-file-comments {:file-id file-id :share-id share-id}))
(rx/take 1)
(rx/map (partial bundle-fetched features))

5
frontend/src/app/main/repo.cljs
View File

@ -17,6 +17,11 @@
(derive :get-file-libraries ::query)
(derive :get-file-fragment ::query)
(derive :search-files ::query)
(derive :get-teams ::query)
(derive :get-team-users ::query)
(derive :get-team-members ::query)
(derive :get-team-stats ::query)
(derive :get-team-invitations ::query)
(defn handle-response
[{:keys [status body] :as response}]

186
frontend/src/app/main/ui/dashboard/team.cljs
View File

@ -448,81 +448,113 @@
:pending (= status :pending))}
[:span.status-label (tr status-label)]]))
(mf/defc invitation-actions [{:keys [can-modify? delete resend] :as props}]
(let [show? (mf/use-state false)]
(when can-modify?
[:*
[:span.icon {:on-click #(reset! show? true)} [i/actions]]
[:& dropdown {:show @show?
:on-close #(reset! show? false)}
[:ul.dropdown.actions-dropdown
[:li {:on-click resend} (tr "labels.resend-invitation")]
[:li {:on-click delete} (tr "labels.delete-invitation")]]]])))
(mf/defc invitation-actions
[{:keys [invitation team] :as props}]
(let [show? (mf/use-state false)
team-id (:id team)
email (:email invitation)
role (:role invitation)
on-resend-success
(mf/use-fn
(fn []
(st/emit! (msg/success (tr "notifications.invitation-email-sent"))
(modal/hide))))
on-copy-success
(mf/use-fn
(fn []
(st/emit! (msg/success (tr "notifications.invitation-link-copied"))
(modal/hide))))
on-error
(mf/use-fn
(mf/deps email)
(fn [{:keys [type code] :as error}]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(rx/of (msg/error (tr "errors.profile-is-muted")))
(and (= :validation type)
(= :member-is-muted code))
(rx/of (msg/error (tr "errors.member-is-muted")))
(and (= :validation type)
(= :email-has-permanent-bounces code))
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" email)))
:else
(rx/throw error))))
delete-fn
(mf/use-fn
(mf/deps email team-id)
(fn []
(let [params {:email email :team-id team-id}
mdata {:on-success #(st/emit! (dd/fetch-team-invitations))}]
(st/emit! (dd/delete-team-invitation (with-meta params mdata))))))
resend-fn
(mf/use-fn
(mf/deps email team-id)
(fn []
(let [params (with-meta {:emails [email]
:team-id team-id
:resend? true
:role role}
{:on-success on-resend-success
:on-error on-error})]
(st/emit!
(-> (dd/invite-team-members params)
(with-meta {::ev/origin :team}))))))
copy-fn
(mf/use-fn
(mf/deps email team-id)
(fn []
(let [params (with-meta {:email email :team-id team-id}
{:on-success on-copy-success
:on-error on-error})]
(prn "KKK1")
(st/emit!
(-> (dd/copy-invitation-link params)
(with-meta {::ev/origin :team}))))))]
[:*
[:span.icon {:on-click #(reset! show? true)} [i/actions]]
[:& dropdown {:show @show?
:on-close #(reset! show? false)}
[:ul.dropdown.actions-dropdown
[:li {:on-click copy-fn} (tr "labels.copy-invitation-link")]
[:li {:on-click resend-fn} (tr "labels.resend-invitation")]
[:li {:on-click delete-fn} (tr "labels.delete-invitation")]]]]))
(mf/defc invitation-row
{::mf/wrap [mf/memo]}
[{:keys [invitation can-invite? team] :as props}]
(let [expired? (:expired invitation)
email (:email invitation)
invitation-role (:role invitation)
status (if expired?
:expired
:pending)
on-success
#(st/emit! (msg/success (tr "notifications.invitation-email-sent"))
(modal/hide)
(dd/fetch-team-invitations))
on-error
(fn [email {:keys [type code] :as error}]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(msg/error (tr "errors.profile-is-muted"))
(and (= :validation type)
(= :member-is-muted code))
(msg/error (tr "errors.member-is-muted"))
(and (= :validation type)
(= :email-has-permanent-bounces code))
(msg/error (tr "errors.email-has-permanent-bounces" email))
:else
(msg/error (tr "errors.generic"))))
(let [expired? (:expired invitation)
email (:email invitation)
role (:role invitation)
status (if expired? :expired :pending)
change-rol
(fn [role]
(let [params {:email email :team-id (:id team) :role role}
mdata {:on-success #(st/emit! (dd/fetch-team-invitations))}]
(st/emit! (dd/update-team-invitation-role (with-meta params mdata)))))
(mf/use-fn
(mf/deps team email)
(fn [role]
(let [params {:email email :team-id (:id team) :role role}
mdata {:on-success #(st/emit! (dd/fetch-team-invitations))}]
(st/emit! (dd/update-team-invitation-role (with-meta params mdata))))))]
delete-invitation
(fn []
(let [params {:email email :team-id (:id team)}
mdata {:on-success #(st/emit! (dd/fetch-team-invitations))}]
(st/emit! (dd/delete-team-invitation (with-meta params mdata)))))
resend-invitation
(fn []
(let [params {:emails [email]
:team-id (:id team)
:resend? true
:role invitation-role}
mdata {:on-success on-success
:on-error (partial on-error email)}]
(st/emit! (-> (dd/invite-team-members (with-meta params mdata))
(with-meta {::ev/origin :team}))
(dd/fetch-team-invitations))))]
[:div.table-row
[:div.table-field.mail email]
[:div.table-field.roles
[:& invitation-role-selector
{:can-invite? can-invite?
:role invitation-role
:role role
:status status
:change-to-editor (partial change-rol :editor)
:change-to-admin (partial change-rol :admin)}]]
@ -530,20 +562,22 @@
[:div.table-field.status
[:& invitation-status-badge {:status status}]]
[:div.table-field.actions
[:& invitation-actions
{:can-modify? can-invite?
:delete delete-invitation
:resend resend-invitation}]]]))
(when can-invite?
[:& invitation-actions
{:invitation invitation
:team team}])]]))
(mf/defc empty-invitation-table [can-invite?]
(mf/defc empty-invitation-table
[{:keys [can-invite?] :as props}]
[:div.empty-invitations
[:span (tr "labels.no-invitations")]
(when (:can-invite? can-invite?) [:span (tr "labels.no-invitations-hint")])])
(when can-invite?
[:span (tr "labels.no-invitations-hint")])])
(mf/defc invitation-section
[{:keys [team invitations] :as props}]
(let [owner? (get-in team [:permissions :is-owner])
admin? (get-in team [:permissions :is-admin])
(let [owner? (dm/get-in team [:permissions :is-owner])
admin? (dm/get-in team [:permissions :is-admin])
can-invite? (or owner? admin?)]
[:div.dashboard-table.invitations
@ -555,7 +589,11 @@
[:& empty-invitation-table {:can-invite? can-invite?}]
[:div.table-rows
(for [invitation invitations]
[:& invitation-row {:key (:email invitation) :invitation invitation :can-invite? can-invite? :team team}])])]))
[:& invitation-row
{:key (:email invitation)
:invitation invitation
:can-invite? can-invite?
:team team}])])]))
(mf/defc team-invitations-page
[{:keys [team] :as props}]
@ -568,7 +606,7 @@
(tr "dashboard.your-penpot")
(:name team)))))
(mf/with-effect
(mf/with-effect []
(st/emit! (dd/fetch-team-invitations)))
[:*
@ -582,7 +620,7 @@
;; WEBHOOKS SECTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::uri ::us/not-empty-string)
(s/def ::uri ::us/uri)
(s/def ::mtype ::us/not-empty-string)
(s/def ::webhook-form
(s/keys :req-un [::uri ::mtype]))
@ -619,6 +657,8 @@
(let [message (cond
(= hint "unknown")
(tr "errors.webhooks.unexpected")
(= hint "invalid-uri")
(tr "errors.webhooks.invalid-uri")
(= hint "ssl-validation-error")
(tr "errors.webhooks.ssl-validation")
(= hint "timeout")

37
frontend/src/app/main/ui/routes.cljs
View File

@ -10,9 +10,9 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.router :as rt]
[app.util.storage :refer [storage]]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
@ -93,32 +93,17 @@
(defn on-navigate
[router path]
(let [match (match-path router path)
profile (:profile @storage)
nopath? (or (= path "") (= path "/"))
path-name (-> match :data :name)
authpath? (some #(= path-name %) '(:auth-login
:auth-register
:auth-register-validate
:auth-register-success
:auth-recovery-request
:auth-recovery))
authed? (and (not (nil? profile))
(not= (:id profile) uuid/zero))]
(if-let [match (match-path router path)]
(st/emit! (rt/navigated match))
(cond
(or (and nopath? authed? (nil? match))
(and authpath? authed?))
(st/emit! (rt/nav :dashboard-projects {:team-id (du/get-current-team-id profile)}))
(and (not authed?) (nil? match))
(st/emit! (rt/nav :auth-login))
(nil? match)
(st/emit! (rt/assign-exception {:type :not-found}))
:else
(st/emit! (rt/navigated match)))))
;; 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)
(rx/subs (fn [{:keys [id] :as profile}]
(if (= id uuid/zero)
(st/emit! (rt/nav :auth-login))
(st/emit! (rt/nav :dashboard-projects {:team-id (du/get-current-team-id profile)}))))))))
(defn init-routes
[]

6
frontend/src/app/main/ui/workspace/context_menu.cljs
View File

@ -386,7 +386,7 @@
[:& menu-entry {:title (tr "workspace.shape.menu.add-flex")
:shortcut (sc/get-tooltip :toogle-layout-flex)
:on-click add-flex}]]
is-flex-container?
[:*
[:& menu-separator]
@ -432,7 +432,7 @@
do-update-component-in-bulk #(st/emit! (dwl/update-component-in-bulk component-shapes component-file))
do-restore-component #(st/emit! (dwl/restore-component component-file component-id))
_do-update-remote-component
do-update-remote-component
#(st/emit! (modal/show
{:type :confirm
:message ""
@ -516,7 +516,7 @@
[:& menu-entry {:title (tr "workspace.shape.menu.reset-overrides")
:on-click do-reset-component}]
[:& menu-entry {:title (tr "workspace.shape.menu.update-main")
:on-click _do-update-remote-component}]
:on-click do-update-remote-component}]
[:& menu-entry {:title (tr "workspace.shape.menu.go-main")
:on-click do-navigate-component-file}]])))])
[:& menu-separator]]))

16
frontend/src/app/main/ui/workspace/sidebar/options/menus/component.cljs
View File

@ -57,7 +57,7 @@
do-detach-component
#(st/emit! (dwl/detach-component id))
_do-reset-component
do-reset-component
#(st/emit! (dwl/reset-component id))
do-update-component
@ -66,7 +66,7 @@
do-restore-component
#(st/emit! (dwl/restore-component library-id component-id))
_do-update-remote-component
do-update-remote-component
#(st/emit! (modal/show
{:type :confirm
:message ""
@ -100,27 +100,27 @@
;; app/main/ui/workspace/context_menu.cljs
[:& context-menu {:on-close on-menu-close
:show (:menu-open @local)
:options
:options
(if main-instance?
[[(tr "workspace.shape.menu.show-in-assets") do-show-in-assets]]
(if local-component?
(if is-dangling?
[[(tr "workspace.shape.menu.detach-instance") do-detach-component]
[(tr "workspace.shape.menu.reset-overrides") _do-reset-component]
[(tr "workspace.shape.menu.reset-overrides") do-reset-component]
(when components-v2
[(tr "workspace.shape.menu.restore-main") do-restore-component])]
[[(tr "workspace.shape.menu.detach-instance") do-detach-component]
[(tr "workspace.shape.menu.reset-overrides") _do-reset-component]
[(tr "workspace.shape.menu.reset-overrides") do-reset-component]
[(tr "workspace.shape.menu.update-main") do-update-component]
[(tr "workspace.shape.menu.show-main") do-show-component]])
(if is-dangling?
[[(tr "workspace.shape.menu.detach-instance") do-detach-component]
[(tr "workspace.shape.menu.reset-overrides") _do-reset-component]
[(tr "workspace.shape.menu.reset-overrides") do-reset-component]
(when components-v2
[(tr "workspace.shape.menu.restore-main") do-restore-component])]
[[(tr "workspace.shape.menu.detach-instance") do-detach-component]
[(tr "workspace.shape.menu.reset-overrides") _do-reset-component]
[(tr "workspace.shape.menu.update-main") _do-update-remote-component]
[(tr "workspace.shape.menu.reset-overrides") do-reset-component]
[(tr "workspace.shape.menu.update-main") do-update-remote-component]
[(tr "workspace.shape.menu.go-main") do-navigate-component-file]])))}]]]]])))

18
frontend/translations/en.po
View File

@ -696,6 +696,9 @@ msgstr "Webhook updated successfully."
msgid "dashboard.webhooks.create.success"
msgstr "Webhook created successfully."
msgid "webhooks.last-delivery.success"
msgstr "Last delivery was successfull."
msgid "errors.webhooks.unexpected"
msgstr "Unexpected error on validating"
@ -705,15 +708,15 @@ msgstr "Timeout"
msgid "errors.webhooks.connection"
msgstr "Connection error, url not reacheable"
msgid "webhooks.last-delivery.success"
msgstr "Last delivery was successfull."
msgid "errors.webhooks.last-delivery"
msgstr "Last delivery was not successfull."
msgid "errors.webhooks.ssl-validation"
msgstr "Error on SSL validation."
msgid "errors.webhooks.invalid-uri"
msgstr "URL does not pass validation."
msgid "errors.webhooks.unexpected-status"
msgstr "Unexpected status %s"
@ -1436,6 +1439,10 @@ msgstr "Rename team"
msgid "labels.resend-invitation"
msgstr "Resend invitation"
#: src/app/main/ui/dashboard/team.cljs
msgid "labels.copy-invitation-link"
msgstr "Copy invitation link"
#: src/app/main/ui/static.cljs, src/app/main/ui/static.cljs, src/app/main/ui/static.cljs
msgid "labels.retry"
msgstr "Retry"
@ -1957,6 +1964,10 @@ msgstr "Update a component in a shared library"
msgid "notifications.invitation-email-sent"
msgstr "Invitation sent successfully"
#: src/app/main/ui/dashboard/team.cljs
msgid "notifications.invitation-link-copied"
msgstr "Invitation link copied"
#: src/app/main/ui/settings/delete_account.cljs
msgid "notifications.profile-deletion-not-allowed"
msgstr "You can't delete you profile. Reassign your teams before proceed."
@ -4461,4 +4472,3 @@ msgstr "The font %s could not be loaded"
msgid "errors.bad-font-plural"
msgstr "The fonts %s could not be loaded"

12
frontend/translations/es.po
View File

@ -761,6 +761,9 @@ msgstr "Error en la validación SSL."
msgid "errors.webhooks.unexpected-status"
msgstr "Estado inesperado %s"
msgid "errors.webhooks.invalid-uri"
msgstr "La URL no pasa la validación."
#: src/app/main/ui/alert.cljs
msgid "ds.alert-ok"
msgstr "Ok"
@ -1606,6 +1609,10 @@ msgstr "Renombra el equipo"
msgid "labels.resend-invitation"
msgstr "Reenviar invitacion"
#: src/app/main/ui/dashboard/team.cljs
msgid "labels.copy-invitation-link"
msgstr "Copiar link de invitación"
#: src/app/main/ui/static.cljs, src/app/main/ui/static.cljs
msgid "labels.retry"
msgstr "Reintentar"
@ -2172,6 +2179,11 @@ msgstr "Actualizar un componente en biblioteca"
msgid "notifications.invitation-email-sent"
msgstr "Invitación enviada con éxito"
#: src/app/main/ui/dashboard/team.cljs
msgid "notifications.invitation-link-copied"
msgstr "Enlace de invitacion copiado"
#: src/app/main/ui/settings/delete_account.cljs
msgid "notifications.profile-deletion-not-allowed"
msgstr "No puedes borrar tu perfil. Reasigna tus equipos antes de seguir."