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

Merge remote-tracking branch 'origin/staging' into develop

Browse source
This commit is contained in:
Andrey Antukh 2022-07-28 11:58:30 +02:00
commit 4e2dbdbebe
25 changed files with 474 additions and 270 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
.clj-kondo/hooks/export.clj
View file

@ -53,24 +53,37 @@
[{:keys [:node]}] [{:keys [:node]}]
(let [[rnode rtype ?meta & other] (:children node) (let [[rnode rtype ?meta & other] (:children node)
rsym (gensym (name (:k rtype))) rsym (gensym (name (:k rtype)))
result (api/list-node
[(api/token-node (symbol "do")) [?docs other] (if (api/string-node? ?meta)
[?meta other]
[nil (cons ?meta other)])
[?meta other] (let [?meta (first other)]
(if (api/map-node? ?meta)
[?meta (rest other)]
[nil other]))
nodes [(api/token-node (symbol "do"))
(api/list-node (api/list-node
[(api/token-node (symbol "declare")) [(api/token-node (symbol "declare"))
(api/token-node rsym)]) (api/token-node rsym)])
(if (= :map (:tag ?meta))
(when ?docs
(api/list-node
[(api/token-node (symbol "comment")) ?docs]))
(when ?meta
(api/list-node (api/list-node
[(api/token-node (symbol "reset-meta!")) [(api/token-node (symbol "reset-meta!"))
(api/token-node rsym) (api/token-node rsym)
?meta]) ?meta]))
(api/list-node
[(api/token-node (symbol "comment"))
(api/token-node rsym)]))
(api/list-node (api/list-node
(into [(api/token-node (symbol "defmethod")) (into [(api/token-node (symbol "defmethod"))
(api/token-node rsym) (api/token-node rsym)
rtype] rtype]
(cons ?meta other)))])] other))]
;; (prn "==============" rtype (into {} ?meta)) result (api/list-node (filterv some? nodes))]
;; (prn "=====>" rtype)
;; (prn (api/sexpr result)) ;; (prn (api/sexpr result))
{:node result})) {:node result}))

2
backend/deps.edn
View file

@ -20,7 +20,7 @@
io.lettuce/lettuce-core {:mvn/version "6.1.8.RELEASE"} io.lettuce/lettuce-core {:mvn/version "6.1.8.RELEASE"}
java-http-clj/java-http-clj {:mvn/version "0.4.3"} java-http-clj/java-http-clj {:mvn/version "0.4.3"}
funcool/yetti {:git/tag "v9.2" :git/sha "4ddcc03" funcool/yetti {:git/tag "v9.3" :git/sha "c6e2d0d"
:git/url "https://github.com/funcool/yetti.git" :git/url "https://github.com/funcool/yetti.git"
:exclusions [org.slf4j/slf4j-api]} :exclusions [org.slf4j/slf4j-api]}

54
backend/resources/api-doc-entry.tmpl Normal file
View file

@ -0,0 +1,54 @@
<li class="rpc-item">
<div class="rpc-row-info">
{# <div class="type">{{item.type}}</div> #}
<div class="module">{{item.module}}:</div>
<div class="name">{{item.name}}</div>
<div class="tags">
{% if item.deprecated %}
<span class="tag">
<span>Deprecated:</span>
<span>since v{{item.deprecated}}</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">
<h3>DOCSTRING:</h3>
<section class="padded-section">
{% if item.added %}
<p class="small"><strong>Added:</strong> on v{{item.added}}</p>
{% endif %}
{% if item.deprecated %}
<p class="small"><strong>Deprecated:</strong> since v{{item.deprecated}}</p>
{% endif %}
{% if item.docs %}
<p class="docstring"> {{item.docs}}</p>
{% endif %}
</section>
{% if item.changes %}
<h3>CHANGES:</h3>
<section class="padded-section">
<ul class="changes">
{% for change in item.changes %}
<li><strong>{{change.0}}</strong> - {{change.1}}</li>
{% endfor %}
</ul>
</section>
{% endif %}
<h3>SPEC EXPLAIN:</h3>
<section class="padded-section">
<pre class="spec-explain">{{item.spec}}</pre>
</section>
</div>
</li>

36
backend/resources/api-doc.css
View file

@ -53,7 +53,7 @@ header {
.rpc-item { .rpc-item {
/* border: 1px solid red; */ /* border: 1px solid red; */
cursor: pointer; /* cursor: pointer; */
display: flex; display: flex;
flex-direction: column; flex-direction: column;
} }
@ -109,3 +109,37 @@ header {
padding: 5px 10px; padding: 5px 10px;
padding-bottom: 20px; padding-bottom: 20px;
} }
.rpc-row-detail p {
font-weight: 200;
}
.rpc-row-detail p.small {
margin-top: 2px;
margin-bottom: 2px;
font-size: 10px;
}
.rpc-row-detail p.small {
margin-top: 2px;
margin-bottom: 2px;
font-size: 10px;
}
.rpc-row-detail strong {
font-weight: 500;
}
.rpc-row-detail .changes {
font-weight: 200;
list-style: none;
padding: 0px;
}
.rpc-row-detail .padded-section {
padding: 0px 10px;
}
p.small strong {
font-size: 10px;
}

77
backend/resources/api-doc.tmpl
View file

@ -5,7 +5,10 @@
<meta name="robots" content="noindex,nofollow"> <meta name="robots" content="noindex,nofollow">
<meta http-equiv="x-ua-compatible" content="ie=edge" /> <meta http-equiv="x-ua-compatible" content="ie=edge" />
<title>Builtin API Documentation - Penpot</title> <title>Builtin API Documentation - Penpot</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
<link rel="preconnect" href="https://fonts.googleapis.com">
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
<link href="https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@200;300;400;500;700&display=swap" rel="stylesheet">
<style> <style>
{% include "api-doc.css" %} {% include "api-doc.css" %}
</style> </style>
@ -16,92 +19,28 @@
<body> <body>
<main> <main>
<header> <header>
<h1>Penpot API Documentation</h1> <h1>Penpot API Documentation (v{{version}})</h1>
</header> </header>
<section class="rpc-doc-content"> <section class="rpc-doc-content">
<h2>RPC COMMAND METHODS:</h2> <h2>RPC COMMAND METHODS:</h2>
<ul class="rpc-items"> <ul class="rpc-items">
{% for item in command-methods %} {% for item in command-methods %}
<li class="rpc-item"> {% include "api-doc-entry.tmpl" with item=item %}
<div class="rpc-row-info">
{# <div class="type">{{item.type}}</div> #}
<div class="module">{{item.module}}:</div>
<div class="name">{{item.name}}</div>
<div class="tags">
<span class="tag">
<span>Auth:</span>
<span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
</span>
</div>
</div>
<div class="rpc-row-detail hidden">
{% if item.docs %}
<h3>DOCSTRING:</h3>
<p>{{item.docs}}</p>
{% endif %}
<h3>SPEC EXPLAIN:</h3>
<pre>{{item.spec}}</pre>
</div>
</li>
{% endfor %} {% endfor %}
</ul> </ul>
<h2>RPC QUERY METHODS:</h2> <h2>RPC QUERY METHODS:</h2>
<ul class="rpc-items"> <ul class="rpc-items">
{% for item in query-methods %} {% for item in query-methods %}
<li class="rpc-item"> {% include "api-doc-entry.tmpl" with item=item %}
<div class="rpc-row-info">
{# <div class="type">{{item.type}}</div> #}
<div class="module">{{item.module}}:</div>
<div class="name">{{item.name}}</div>
<div class="tags">
<span class="tag">
<span>Auth:</span>
<span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
</span>
</div>
</div>
<div class="rpc-row-detail hidden">
{% if item.docs %}
<h3>DOCSTRING:</h3>
<p>{{item.docs}}</p>
{% endif %}
<h3>SPEC EXPLAIN:</h3>
<pre>{{item.spec}}</pre>
</div>
</li>
{% endfor %} {% endfor %}
</ul> </ul>
<h2>RPC MUTATION METHODS:</h2> <h2>RPC MUTATION METHODS:</h2>
<ul class="rpc-items"> <ul class="rpc-items">
{% for item in mutation-methods %} {% for item in mutation-methods %}
<li class="rpc-item"> {% include "api-doc-entry.tmpl" with item=item %}
<div class="rpc-row-info">
{# <div class="type">{{item.type}}</div> #}
<div class="module">{{item.module}}:</div>
<div class="name">{{item.name}}</div>
<div class="tags">
<span class="tag">
<span>Auth:</span>
<span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
</span>
</div>
</div>
<div class="rpc-row-detail hidden">
{% if item.docs %}
<h3>DOCSTRING:</h3>
<p>{{item.docs}}</p>
{% endif %}
<h3>SPEC EXPLAIN:</h3>
<pre>{{item.spec}}</pre>
</div>
</li>
{% endfor %} {% endfor %}
</ul> </ul>
</section> </section>

6
backend/src/app/db.clj
View file

@ -323,9 +323,9 @@
(and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v)))) (and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v))))
(defn decode-pgarray (defn decode-pgarray
([v] (into [] (.getArray ^PgArray v))) ([v] (some->> ^PgArray v .getArray vec))
([v in] (into in (.getArray ^PgArray v))) ([v in] (some->> ^PgArray v .getArray (into in)))
([v in xf] (into in xf (.getArray ^PgArray v)))) ([v in xf] (some->> ^PgArray v .getArray (into in xf))))
(defn pgarray->set (defn pgarray->set
[v] [v]

7
backend/src/app/http/awsns.clj
View file

@ -16,6 +16,7 @@
[integrant.core :as ig] [integrant.core :as ig]
[jsonista.core :as j] [jsonista.core :as j]
[promesa.exec :as px] [promesa.exec :as px]
[yetti.request :as yrq]
[yetti.response :as yrs])) [yetti.response :as yrs]))
(declare parse-json) (declare parse-json)
@ -31,9 +32,9 @@
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [executor] :as cfg}] [_ {:keys [executor] :as cfg}]
(fn [request respond _] (fn [request respond _]
(let [data (slurp (:body request))] (let [data (-> request yrq/body slurp)]
(px/run! executor #(handle-request cfg data)) (px/run! executor #(handle-request cfg data)))
(respond (yrs/response 200))))) (respond (yrs/response 200))))
(defn handle-request (defn handle-request
[{:keys [http-client] :as cfg} data] [{:keys [http-client] :as cfg} data]

4
backend/src/app/http/middleware.clj
View file

@ -37,14 +37,14 @@
(let [header (yrq/get-header request "content-type")] (let [header (yrq/get-header request "content-type")]
(cond (cond
(str/starts-with? header "application/transit+json") (str/starts-with? header "application/transit+json")
(with-open [is (-> request yrq/body yrq/body-stream)] (with-open [is (yrq/body request)]
(let [params (t/read! (t/reader is))] (let [params (t/read! (t/reader is))]
(-> request (-> request
(assoc :body-params params) (assoc :body-params params)
(update :params merge params)))) (update :params merge params))))
(str/starts-with? header "application/json") (str/starts-with? header "application/json")
(with-open [is (-> request yrq/body yrq/body-stream)] (with-open [is (yrq/body request)]
(let [params (json/read is)] (let [params (json/read is)]
(-> request (-> request
(assoc :body-params params) (assoc :body-params params)

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

@ -91,9 +91,6 @@
:app.http/session :app.http/session
{:store (ig/ref :app.http.session/store)} {:store (ig/ref :app.http.session/store)}
:app.http.doc/routes
{:methods (ig/ref :app.rpc/methods)}
:app.http.session/store :app.http.session/store
{:pool (ig/ref :app.db/pool) {:pool (ig/ref :app.db/pool)
:tokens (ig/ref :app.tokens/tokens) :tokens (ig/ref :app.tokens/tokens)
@ -201,7 +198,7 @@
:tokens (ig/ref :app.tokens/tokens) :tokens (ig/ref :app.tokens/tokens)
:audit-handler (ig/ref :app.loggers.audit/http-handler) :audit-handler (ig/ref :app.loggers.audit/http-handler)
:rpc-routes (ig/ref :app.rpc/routes) :rpc-routes (ig/ref :app.rpc/routes)
:doc-routes (ig/ref :app.http.doc/routes) :doc-routes (ig/ref :app.rpc.doc/routes)
:executor (ig/ref [::default :app.worker/executor])} :executor (ig/ref [::default :app.worker/executor])}
:app.http.debug/routes :app.http.debug/routes
@ -240,6 +237,9 @@
:http-client (ig/ref :app.http/client) :http-client (ig/ref :app.http/client)
:executors (ig/ref :app.worker/executors)} :executors (ig/ref :app.worker/executors)}
:app.rpc.doc/routes
{:methods (ig/ref :app.rpc/methods)}
:app.rpc/routes :app.rpc/routes
{:methods (ig/ref :app.rpc/methods)} {:methods (ig/ref :app.rpc/methods)}

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

@ -241,6 +241,7 @@
[cfg] [cfg]
(let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)] (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
(->> (sv/scan-ns 'app.rpc.commands.binfile (->> (sv/scan-ns 'app.rpc.commands.binfile
'app.rpc.commands.comments
'app.rpc.commands.auth 'app.rpc.commands.auth
'app.rpc.commands.ldap 'app.rpc.commands.ldap
'app.rpc.commands.demo) 'app.rpc.commands.demo)

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

@ -13,6 +13,7 @@
[app.db :as db] [app.db :as db]
[app.emails :as eml] [app.emails :as eml]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc.doc :as-alias doc]
[app.rpc.mutations.teams :as teams] [app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.rpc.rlimit :as rlimit] [app.rpc.rlimit :as rlimit]
@ -133,7 +134,9 @@
(sv/defmethod ::login-with-password (sv/defmethod ::login-with-password
"Performs authentication using penpot password." "Performs authentication using penpot password."
{:auth false ::rlimit/permits (cf/get :rlimit-password)} {:auth false
::rlimit/permits (cf/get :rlimit-password)
::doc/added "1.15"}
[cfg params] [cfg params]
(login-with-password cfg params)) (login-with-password cfg params))
@ -144,7 +147,8 @@
(sv/defmethod ::logout (sv/defmethod ::logout
"Clears the authentication cookie and logout the current session." "Clears the authentication cookie and logout the current session."
{:auth false} {:auth false
::doc/added "1.15"}
[{:keys [session] :as cfg} _] [{:keys [session] :as cfg} _]
(with-meta {} (with-meta {}
{:transform-response (:delete session)})) {:transform-response (:delete session)}))
@ -171,7 +175,9 @@
(s/keys :req-un [::token ::password])) (s/keys :req-un [::token ::password]))
(sv/defmethod ::recover-profile (sv/defmethod ::recover-profile
{:auth false ::rlimit/permits (cf/get :rlimit-password)} {:auth false
::rlimit/permits (cf/get :rlimit-password)
::doc/added "1.15"}
[cfg params] [cfg params]
(recover-profile cfg params)) (recover-profile cfg params))
@ -224,7 +230,9 @@
(s/keys :req-un [::email ::password] (s/keys :req-un [::email ::password]
:opt-un [::invitation-token])) :opt-un [::invitation-token]))
(sv/defmethod ::prepare-register-profile {:auth false} (sv/defmethod ::prepare-register-profile
{:auth false
::doc/added "1.15"}
[cfg params] [cfg params]
(prepare-register cfg params)) (prepare-register cfg params))
@ -355,7 +363,9 @@
(s/keys :req-un [::token ::fullname])) (s/keys :req-un [::token ::fullname]))
(sv/defmethod ::register-profile (sv/defmethod ::register-profile
{:auth false ::rlimit/permits (cf/get :rlimit-password)} {:auth false
::rlimit/permits (cf/get :rlimit-password)
::doc/added "1.15"}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(-> (assoc cfg :conn conn) (-> (assoc cfg :conn conn)
@ -409,7 +419,9 @@
(s/def ::request-profile-recovery (s/def ::request-profile-recovery
(s/keys :req-un [::email])) (s/keys :req-un [::email]))
(sv/defmethod ::request-profile-recovery {:auth false} (sv/defmethod ::request-profile-recovery
{:auth false
::doc/added "1.15"}
[cfg params] [cfg params]
(request-profile-recovery cfg params)) (request-profile-recovery cfg params))

3
backend/src/app/rpc/commands/binfile.clj
View file

@ -16,6 +16,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.media :as media] [app.media :as media]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.files :as files] [app.rpc.queries.files :as files]
[app.rpc.queries.projects :as projects] [app.rpc.queries.projects :as projects]
[app.storage :as sto] [app.storage :as sto]
@ -808,6 +809,7 @@
(sv/defmethod ::export-binfile (sv/defmethod ::export-binfile
"Export a penpot file in a binary format." "Export a penpot file in a binary format."
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(files/check-read-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
@ -827,6 +829,7 @@
(sv/defmethod ::import-binfile (sv/defmethod ::import-binfile
"Import a penpot file in a binary format." "Import a penpot file in a binary format."
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id project-id file] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id project-id file] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(projects/check-read-permissions! conn profile-id project-id) (projects/check-read-permissions! conn profile-id project-id)

202
backend/src/app/rpc/commands/comments.clj Normal file
View file

@ -0,0 +1,202 @@
;; 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) UXBOX Labs SL
(ns app.rpc.commands.comments
(:require
[app.common.spec :as us]
[app.db :as db]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.files :as files]
[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))))
;; --- COMMAND: Get Comment Threads
(declare retrieve-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::get-comment-threads
(s/and (s/keys :req-un [::profile-id]
:opt-un [::file-id ::share-id ::team-id])
#(or (:file-id %) (:team-id %))))
(sv/defmethod ::get-comment-threads
[{:keys [pool] :as cfg} params]
(with-open [conn (db/open pool)]
(retrieve-comment-threads conn params)))
(def sql:comment-threads
"select distinct on (ct.id)
ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content,
(select count(1)
from comment as c
where c.thread_id = ct.id) as count_comments,
(select count(1)
from comment as c
where c.thread_id = ct.id
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
left join comment_thread_status as cts
on (cts.thread_id = ct.id and
cts.profile_id = ?)
where ct.file_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(defn retrieve-comment-threads
[conn {:keys [profile-id file-id share-id]}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(->> (db/exec! conn [sql:comment-threads profile-id file-id])
(into [] (map decode-row))))
;; --- COMMAND: Get Unread Comment Threads
(declare retrieve-unread-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::get-unread-comment-threads
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::get-unread-comment-threads
[{: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)
(retrieve-unread-comment-threads conn params)))
(def sql:comment-threads-by-team
"select distinct on (ct.id)
ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content,
(select count(1)
from comment as c
where c.thread_id = ct.id) as count_comments,
(select count(1)
from comment as c
where c.thread_id = ct.id
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
inner join project as p on (p.id = f.project_id)
left join comment_thread_status as cts
on (cts.thread_id = ct.id and
cts.profile_id = ?)
where p.team_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(def sql:unread-comment-threads-by-team
(str "with threads as (" sql:comment-threads-by-team ")"
"select * from threads where count_unread_comments > 0"))
(defn retrieve-unread-comment-threads
[conn {:keys [profile-id team-id]}]
(->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
(into [] (map decode-row))))
;; --- COMMAND: Get Single Comment Thread
(s/def ::id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::get-comment-thread
(s/keys :req-un [::profile-id ::file-id ::id]
:opt-un [::share-id]))
(sv/defmethod ::get-comment-thread
[{: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)
(let [sql (str "with threads as (" sql:comment-threads ")"
"select * from threads where id = ?")]
(-> (db/exec-one! conn [sql profile-id file-id id])
(decode-row)))))
;; --- COMMAND: Comments
(declare retrieve-comments)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::thread-id ::us/uuid)
(s/def ::get-comments
(s/keys :req-un [::profile-id ::thread-id]
:opt-un [::share-id]))
(sv/defmethod ::get-comments
[{: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)]
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(retrieve-comments conn thread-id))))
(def sql:comments
"select c.* from comment as c
where c.thread_id = ?
order by c.created_at asc")
(defn retrieve-comments
[conn thread-id]
(->> (db/exec! conn [sql:comments thread-id])
(into [] (map decode-row))))
;; --- COMMAND: Get file comments users
(declare retrieve-file-comments-users)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::get-profiles-for-file-comments
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::share-id]))
(sv/defmethod ::get-profiles-for-file-comments
"Retrieves a list of profiles with limited set of properties of all
participants on comment threads of the file."
{::doc/added "1.15"
::doc/changes ["1.15" "Imported from queries and renamed."]}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}]
(with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(retrieve-file-comments-users conn file-id profile-id)))
;; All the profiles that had comment the file, plus the current
;; profile.
(def sql:file-comment-users
"WITH available_profiles AS (
SELECT DISTINCT owner_id AS id
FROM comment
WHERE thread_id IN (SELECT id FROM comment_thread WHERE file_id=?)
)
SELECT p.id,
p.email,
p.fullname AS name,
p.fullname AS fullname,
p.photo_id,
p.is_active
FROM profile AS p
WHERE p.id IN (SELECT id FROM available_profiles) OR p.id=?")
(defn retrieve-file-comments-users
[conn file-id profile-id]
(db/exec! conn [sql:file-comment-users file-id profile-id]))

9
backend/src/app/rpc/commands/demo.clj
View file

@ -13,6 +13,7 @@
[app.db :as db] [app.db :as db]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
@ -21,7 +22,13 @@
(s/def ::create-demo-profile any?) (s/def ::create-demo-profile any?)
(sv/defmethod ::create-demo-profile {:auth false} (sv/defmethod ::create-demo-profile
"A command that is responsible of creating a demo purpose
profile. It only works if the `demo-users` flag is inabled in the
configuration."
{:auth false
::doc/added "1.15"
::doc/changes ["1.15" "This methos is migrated from mutations to commands."]}
[{:keys [pool] :as cfg} _] [{:keys [pool] :as cfg} _]
(let [id (uuid/next) (let [id (uuid/next)
sem (System/currentTimeMillis) sem (System/currentTimeMillis)

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

@ -12,6 +12,7 @@
[app.db :as db] [app.db :as db]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.util.services :as sv] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -28,7 +29,11 @@
(s/keys :req-un [::email ::password] (s/keys :req-un [::email ::password]
:opt-un [::invitation-token])) :opt-un [::invitation-token]))
(sv/defmethod ::login-with-ldap {:auth false} (sv/defmethod ::login-with-ldap
"Performs the authentication using LDAP backend. Only works if LDAP
is properly configured and enabled with `login-with-ldap` flag."
{:auth false
::doc/added "1.15"}
[{:keys [session tokens ldap] :as cfg} params] [{:keys [session tokens ldap] :as cfg} params]
(when-not ldap (when-not ldap
(ex/raise :type :restriction (ex/raise :type :restriction

10
backend/src/app/http/doc.clj → backend/src/app/rpc/doc.clj
View file

@ -4,7 +4,7 @@
;; ;;
;; Copyright (c) UXBOX Labs SL ;; Copyright (c) UXBOX Labs SL
(ns app.http.doc (ns app.rpc.doc
"API autogenerated documentation." "API autogenerated documentation."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
@ -35,10 +35,14 @@
:name (d/name name) :name (d/name name)
:module (-> (:ns mdata) (str/split ".") last) :module (-> (:ns mdata) (str/split ".") last)
:auth (:auth mdata true) :auth (:auth mdata true)
:docs (::sv/docs mdata) :docs (::sv/docstring mdata)
:deprecated (::deprecated mdata)
:added (::added mdata)
:changes (some->> (::changes mdata) (partition-all 2) (map vec))
:spec (get-spec-str (::sv/spec mdata))}))] :spec (get-spec-str (::sv/spec mdata))}))]
{:command-methods {:version (:main cf/version)
:command-methods
(->> (:commands methods) (->> (:commands methods)
(map (partial gen-doc :command)) (map (partial gen-doc :command))
(sort-by (juxt :module :name))) (sort-by (juxt :module :name)))

17
backend/src/app/rpc/mutations/comments.clj
View file

@ -10,6 +10,7 @@
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.comments :as comments] [app.rpc.queries.comments :as comments]
[app.rpc.queries.files :as files] [app.rpc.queries.files :as files]
[app.rpc.retry :as retry] [app.rpc.retry :as retry]
@ -37,7 +38,9 @@
(sv/defmethod ::create-comment-thread (sv/defmethod ::create-comment-thread
{::retry/max-retries 3 {::retry/max-retries 3
::retry/matches retry/conflict-db-insert?} ::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}] [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
@ -101,6 +104,8 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::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}] [{:keys [pool] :as cfg} {:keys [profile-id id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})] (let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
@ -130,6 +135,8 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::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}] [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})] (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
@ -151,6 +158,8 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::add-comment (sv/defmethod ::add-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id thread-id content share-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id thread-id content share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true}) (let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
@ -209,6 +218,8 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::update-comment (sv/defmethod ::update-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id content share-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id content share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true}) (let [comment (db/get-by-id conn :comment id {:for-update true})
@ -242,6 +253,8 @@
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sv/defmethod ::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}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})] (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
@ -258,6 +271,8 @@
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sv/defmethod ::delete-comment (sv/defmethod ::delete-comment
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})] (let [comment (db/get-by-id conn :comment id {:for-update true})]

2
backend/src/app/rpc/mutations/fonts.clj
View file

@ -13,6 +13,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.media :as media] [app.media :as media]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.teams :as teams] [app.rpc.queries.teams :as teams]
[app.rpc.rlimit :as rlimit] [app.rpc.rlimit :as rlimit]
[app.storage :as sto] [app.storage :as sto]
@ -151,6 +152,7 @@
(s/keys :req-un [::profile-id ::team-id ::id])) (s/keys :req-un [::profile-id ::team-id ::id]))
(sv/defmethod ::delete-font-variant (sv/defmethod ::delete-font-variant
{::doc/added "1.3"}
[{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id) (teams/check-edition-permissions! conn profile-id team-id)

130
backend/src/app/rpc/queries/comments.clj
View file

@ -8,6 +8,8 @@
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.rpc.commands.comments :as cmd.comments]
[app.rpc.doc :as-alias doc]
[app.rpc.queries.files :as files] [app.rpc.queries.files :as files]
[app.rpc.queries.teams :as teams] [app.rpc.queries.teams :as teams]
[app.util.services :as sv] [app.util.services :as sv]
@ -19,9 +21,7 @@
(db/pgpoint? position) (assoc :position (db/decode-pgpoint position)) (db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
(db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants)))) (db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
;; --- Query: Comment Threads ;; --- QUERY: Comment Threads
(declare retrieve-comment-threads)
(s/def ::team-id ::us/uuid) (s/def ::team-id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
@ -33,87 +33,27 @@
#(or (:file-id %) (:team-id %)))) #(or (:file-id %) (:team-id %))))
(sv/defmethod ::comment-threads (sv/defmethod ::comment-threads
{::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} params]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(retrieve-comment-threads conn params))) (cmd.comments/retrieve-comment-threads conn params)))
(def sql:comment-threads
"select distinct on (ct.id)
ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content,
(select count(1)
from comment as c
where c.thread_id = ct.id) as count_comments,
(select count(1)
from comment as c
where c.thread_id = ct.id
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
left join comment_thread_status as cts
on (cts.thread_id = ct.id and
cts.profile_id = ?)
where ct.file_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(defn- retrieve-comment-threads
[conn {:keys [profile-id file-id share-id]}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(->> (db/exec! conn [sql:comment-threads profile-id file-id])
(into [] (map decode-row))))
;; --- Query: Unread Comment Threads ;; --- QUERY: Unread Comment Threads
(declare retrieve-unread-comment-threads)
(s/def ::team-id ::us/uuid) (s/def ::team-id ::us/uuid)
(s/def ::unread-comment-threads (s/def ::unread-comment-threads
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::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}] [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id) (teams/check-read-permissions! conn profile-id team-id)
(retrieve-unread-comment-threads conn params))) (cmd.comments/retrieve-unread-comment-threads conn params)))
(def sql:comment-threads-by-team ;; --- QUERY: Single Comment Thread
"select distinct on (ct.id)
ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content,
(select count(1)
from comment as c
where c.thread_id = ct.id) as count_comments,
(select count(1)
from comment as c
where c.thread_id = ct.id
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
inner join project as p on (p.id = f.project_id)
left join comment_thread_status as cts
on (cts.thread_id = ct.id and
cts.profile_id = ?)
where p.team_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(def sql:unread-comment-threads-by-team
(str "with threads as (" sql:comment-threads-by-team ")"
"select * from threads where count_unread_comments > 0"))
(defn retrieve-unread-comment-threads
[conn {:keys [profile-id team-id]}]
(->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
(into [] (map decode-row))))
;; --- Query: Single Comment Thread
(s/def ::id ::us/uuid) (s/def ::id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid)) (s/def ::share-id (s/nilable ::us/uuid))
@ -122,17 +62,17 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::comment-thread (sv/defmethod ::comment-thread
{::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id id share-id] :as params}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(let [sql (str "with threads as (" sql:comment-threads ")" (let [sql (str "with threads as (" cmd.comments/sql:comment-threads ")"
"select * from threads where id = ?")] "select * from threads where id = ?")]
(-> (db/exec-one! conn [sql profile-id file-id id]) (-> (db/exec-one! conn [sql profile-id file-id id])
(decode-row))))) (decode-row)))))
;; --- Query: Comments ;; --- QUERY: Comments
(declare retrieve-comments)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid)) (s/def ::share-id (s/nilable ::us/uuid))
@ -142,25 +82,15 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::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}] [{:keys [pool] :as cfg} {:keys [profile-id thread-id share-id] :as params}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)] (let [thread (db/get-by-id conn :comment-thread thread-id)]
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id) (files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(retrieve-comments conn thread-id)))) (cmd.comments/retrieve-comments conn thread-id))))
(def sql:comments ;; --- QUERY: Get file comments users
"select c.* from comment as c
where c.thread_id = ?
order by c.created_at asc")
(defn- retrieve-comments
[conn thread-id]
(->> (db/exec! conn [sql:comments thread-id])
(into [] (map decode-row))))
;; file-comments-users
(declare retrieve-file-comments-users)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid)) (s/def ::share-id (s/nilable ::us/uuid))
@ -170,27 +100,9 @@
:opt-un [::share-id])) :opt-un [::share-id]))
(sv/defmethod ::file-comments-users (sv/defmethod ::file-comments-users
{::doc/deprecated "1.15"
::doc/added "1.13"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}] [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(retrieve-file-comments-users conn file-id profile-id))) (cmd.comments/retrieve-file-comments-users conn file-id profile-id)))
(def sql:file-comment-users
"select p.id,
p.email,
p.fullname as name,
p.fullname as fullname,
p.photo_id,
p.is_active
from profile p
where p.id in
(select owner_id from comment
where thread_id in
(select id from comment_thread
where file_id=?))
or p.id=?
") ;; all the users that had comment the file, plus the current user
(defn retrieve-file-comments-users
[conn file-id profile-id]
(db/exec! conn [sql:file-comment-users file-id profile-id]))

2
backend/src/app/rpc/queries/viewer.clj
View file

@ -9,7 +9,7 @@
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.rpc.queries.comments :as comments] [app.rpc.commands.comments :as comments]
[app.rpc.queries.files :as files] [app.rpc.queries.files :as files]
[app.rpc.queries.share-link :as slnk] [app.rpc.queries.share-link :as slnk]
[app.util.services :as sv] [app.util.services :as sv]

5
backend/src/app/tokens.clj
View file

@ -18,7 +18,10 @@
(defn- generate (defn- generate
[cfg claims] [cfg claims]
(let [payload (-> claims d/without-nils t/encode)] (let [payload (-> claims
(assoc :iat (dt/now))
(d/without-nils)
(t/encode))]
(jwe/encrypt payload (::secret cfg) {:alg :a256kw :enc :a256gcm}))) (jwe/encrypt payload (::secret cfg) {:alg :a256kw :enc :a256gcm})))
(defn- verify (defn- verify

2
backend/src/app/util/services.clj
View file

@ -27,7 +27,7 @@
(throw (IllegalArgumentException. "Missing arguments on `defmethod` macro."))) (throw (IllegalArgumentException. "Missing arguments on `defmethod` macro.")))
(let [mdata (assoc mdata (let [mdata (assoc mdata
::docs (some-> docs str/<<-) ::docstring (some-> docs str/<<-)
::spec sname ::spec sname
::name (name sname)) ::name (name sname))

6
common/src/app/common/pages/helpers.cljc
View file

@ -161,8 +161,7 @@
(defn get-frames (defn get-frames
"Retrieves all frame objects as vector" "Retrieves all frame objects as vector"
[objects] [objects]
(if (contains? (meta objects) ::index-frames) (or (-> objects meta ::index-frames)
(::index-frames (meta objects))
(let [lookup (d/getf objects) (let [lookup (d/getf objects)
xform (comp (remove #(= uuid/zero %)) xform (comp (remove #(= uuid/zero %))
(keep lookup) (keep lookup)
@ -704,11 +703,10 @@
(into [] (into []
(comp (map (d/getf objects)) (comp (map (d/getf objects))
(if all-frames? (if all-frames?
identity (map identity)
(remove :hide-in-viewer))) (remove :hide-in-viewer)))
(sort-z-index objects (get-frames-ids objects) {:top-frames? true})))) (sort-z-index objects (get-frames-ids objects) {:top-frames? true}))))
(defn start-page-index (defn start-page-index
[objects] [objects]
(with-meta objects {::index-frames (get-frames (with-meta objects nil))})) (with-meta objects {::index-frames (get-frames (with-meta objects nil))}))

3
docker/devenv/Dockerfile
View file

@ -3,7 +3,7 @@ LABEL maintainer="Andrey Antukh <niwi@niwi.nz>"
ARG DEBIAN_FRONTEND=noninteractive ARG DEBIAN_FRONTEND=noninteractive
ENV NODE_VERSION=v16.15.1 \ ENV NODE_VERSION=v16.16.0 \
CLOJURE_VERSION=1.11.1.1149 \ CLOJURE_VERSION=1.11.1.1149 \
CLJKONDO_VERSION=2022.06.22 \ CLJKONDO_VERSION=2022.06.22 \
BABASHKA_VERSION=0.8.156 \ BABASHKA_VERSION=0.8.156 \
@ -57,6 +57,7 @@ RUN set -ex; \
woff-tools \ woff-tools \
woff2 \ woff2 \
fontforge \ fontforge \
openssh-client \
; \ ; \
rm -rf /var/lib/apt/lists/*; rm -rf /var/lib/apt/lists/*;

54
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -7,6 +7,7 @@
(ns app.main.data.workspace.shapes (ns app.main.data.workspace.shapes
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.proportions :as gpr] [app.common.geom.proportions :as gpr]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb] [app.common.pages.changes-builder :as pcb]
@ -142,14 +143,15 @@
page (wsh/lookup-page state page-id) page (wsh/lookup-page state page-id)
ids (cph/clean-loops objects ids) ids (cph/clean-loops objects ids)
lookup (d/getf objects)
groups-to-unmask groups-to-unmask
(reduce (fn [group-ids id] (reduce (fn [group-ids id]
;; When the shape to delete is the mask of a masked group, ;; When the shape to delete is the mask of a masked group,
;; the mask condition must be removed, and it must be ;; the mask condition must be removed, and it must be
;; converted to a normal group. ;; converted to a normal group.
(let [obj (get objects id) (let [obj (lookup id)
parent (get objects (:parent-id obj))] parent (lookup (:parent-id obj))]
(if (and (:masked-group? parent) (if (and (:masked-group? parent)
(= id (first (:shapes parent)))) (= id (first (:shapes parent))))
(conj group-ids (:id parent)) (conj group-ids (:id parent))
@ -168,9 +170,11 @@
(vals objects)) (vals objects))
;; If any of the deleted shapes is a frame with guides ;; If any of the deleted shapes is a frame with guides
guides (into {} (map (juxt :id identity) (->> (get-in page [:options :guides]) guides (into {}
(vals) (comp (map second)
(filter #(not (contains? ids (:frame-id %))))))) (remove #(contains? ids (:frame-id %)))
(map (juxt :id identity)))
(dm/get-in page [:options :guides]))
starting-flows starting-flows
(filter (fn [flow] (filter (fn [flow]
@ -194,22 +198,18 @@
(reverse) (reverse)
(into (d/ordered-set))) (into (d/ordered-set)))
find-all-empty-parents (fn recursive-find-empty-parents [empty-parents] find-all-empty-parents
(fn recursive-find-empty-parents [empty-parents]
(let [all-ids (into empty-parents ids) (let [all-ids (into empty-parents ids)
empty-parents-xform contains? (partial contains? all-ids)
(comp xform (comp (map lookup)
(map (fn [id] (get objects id))) (filter cph/group-shape?)
(map (fn [{:keys [shapes type] :as obj}] (remove #(->> (:shapes %) (remove contains?) seq))
(when (and (= :group type)
(zero? (count (remove #(contains? all-ids %) shapes))))
obj)))
(take-while some?)
(map :id)) (map :id))
calculated-empty-parents (into #{} empty-parents-xform all-parents)] parents (into #{} xform all-parents)]
(if (= empty-parents parents)
(if (= empty-parents calculated-empty-parents)
empty-parents empty-parents
(recursive-find-empty-parents calculated-empty-parents)))) (recursive-find-empty-parents parents))))
empty-parents empty-parents
;; Any parent whose children are all deleted, must be deleted too. ;; Any parent whose children are all deleted, must be deleted too.
@ -228,18 +228,16 @@
(assoc shape :masked-group? false))) (assoc shape :masked-group? false)))
(pcb/update-shapes (map :id interacting-shapes) (pcb/update-shapes (map :id interacting-shapes)
(fn [shape] (fn [shape]
(update shape :interactions (d/update-when shape :interactions
(fn [interactions] (fn [interactions]
(when interactions (into []
(d/removev #(and (csi/has-destination %) (remove #(and (csi/has-destination %)
(contains? ids (:destination %))) (contains? ids (:destination %))))
interactions)))))) interactions)))))
(cond-> (cond-> (seq starting-flows)
(seq starting-flows)
(pcb/update-page-option :flows (fn [flows] (pcb/update-page-option :flows (fn [flows]
(reduce #(csp/remove-flow %1 (:id %2)) (->> (map :id starting-flows)
flows (reduce csp/remove-flow flows))))))]
starting-flows)))))]
(rx/of (dch/commit-changes changes) (rx/of (dch/commit-changes changes)
(dwsl/update-layout-positions all-parents)))))) (dwsl/update-layout-positions all-parents))))))