"
- (explain-error edata)
+ (:explain edata)
"\n")}
{:status 400
- :body (cond-> edata
- (map? (:data edata))
- (-> (assoc :explain (explain-error edata))
- (dissoc :data)))})))
+ :body (dissoc edata :data)})))
(defmethod handle-exception :assertion
[error request]
@@ -77,9 +91,7 @@
{:status 500
:body {:type :server-error
:code :assertion
- :data (-> edata
- (assoc :explain (explain-error edata))
- (dissoc :data))}}))
+ :data (dissoc edata :data)}}))
(defmethod handle-exception :not-found
[err _]
diff --git a/backend/src/app/http/feedback.clj b/backend/src/app/http/feedback.clj
index dd78cfd57..e82a93a4e 100644
--- a/backend/src/app/http/feedback.clj
+++ b/backend/src/app/http/feedback.clj
@@ -10,7 +10,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
- [app.config :as cfg]
+ [app.config :as cf]
[app.db :as db]
[app.emails :as eml]
[app.rpc.queries.profile :as profile]
@@ -24,8 +24,8 @@
(defmethod ig/init-key ::handler
[_ {:keys [pool] :as scfg}]
- (let [ftoken (cfg/get :feedback-token ::no-token)
- enabled (cfg/get :feedback-enabled)]
+ (let [ftoken (cf/get :feedback-token ::no-token)
+ enabled (contains? cf/flags :user-feedback)]
(fn [{:keys [profile-id] :as request}]
(let [token (get-in request [:headers "x-feedback-token"])
params (d/merge (:params request)
@@ -58,7 +58,7 @@
(defn send-feedback
[pool profile params]
(let [params (us/conform ::feedback params)
- destination (cfg/get :feedback-destination)]
+ destination (cf/get :feedback-destination)]
(eml/send! {::eml/conn pool
::eml/factory eml/feedback
:to destination
diff --git a/backend/src/app/http/middleware.clj b/backend/src/app/http/middleware.clj
index c6ee09f2e..8c8bf1151 100644
--- a/backend/src/app/http/middleware.clj
+++ b/backend/src/app/http/middleware.clj
@@ -6,10 +6,11 @@
(ns app.http.middleware
(:require
+ [app.common.logging :as l]
[app.common.transit :as t]
+ [app.config :as cf]
[app.metrics :as mtx]
[app.util.json :as json]
- [app.util.logging :as l]
[buddy.core.codecs :as bc]
[buddy.core.hash :as bh]
[clojure.java.io :as io]
@@ -176,3 +177,29 @@
:uri (str (:uri request) (when qstring (str "?" qstring)))
:method (name (:request-method request)))
(handler request)))))
+
+(defn- wrap-cors
+ [handler]
+ (if-not (contains? cf/flags :cors)
+ handler
+ (letfn [(add-cors-headers [response request]
+ (-> response
+ (update
+ :headers
+ (fn [headers]
+ (-> headers
+ (assoc "access-control-allow-origin" (get-in request [:headers "origin"]))
+ (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH")
+ (assoc "access-control-allow-credentials" "true")
+ (assoc "access-control-expose-headers" "x-requested-with, content-type, cookie")
+ (assoc "access-control-allow-headers" "x-frontend-version, content-type, accept, x-requested-width"))))))]
+ (fn [request]
+ (if (= (:request-method request) :options)
+ (-> {:status 200 :body ""}
+ (add-cors-headers request))
+ (let [response (handler request)]
+ (add-cors-headers response request)))))))
+
+(def cors
+ {:name ::cors
+ :compile (constantly wrap-cors)})
diff --git a/backend/src/app/http/oauth.clj b/backend/src/app/http/oauth.clj
index 528d90427..64b1c7036 100644
--- a/backend/src/app/http/oauth.clj
+++ b/backend/src/app/http/oauth.clj
@@ -8,6 +8,7 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.common.uri :as u]
[app.config :as cf]
@@ -15,7 +16,6 @@
[app.loggers.audit :as audit]
[app.rpc.queries.profile :as profile]
[app.util.http :as http]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.data.json :as json]
[clojure.set :as set]
@@ -62,6 +62,13 @@
:cause e)
nil)))
+(defn- qualify-props
+ [provider props]
+ (reduce-kv (fn [result k v]
+ (assoc result (keyword (:name provider) (name k)) v))
+ {}
+ props))
+
(defn- retrieve-user-info
[{:keys [provider] :as cfg} tdata]
(try
@@ -76,8 +83,8 @@
{:backend (:name provider)
:email (:email info)
:fullname (:name info)
- :props (dissoc info :name :email)})))
-
+ :props (->> (dissoc info :name :email)
+ (qualify-props provider))})))
(catch Exception e
(l/error :hint "unexpected exception on retrieve-user-info"
:cause e)
@@ -138,15 +145,14 @@
;; --- HTTP HANDLERS
-(defn extract-props
+(defn extract-utm-props
+ "Extracts additional data from user params."
[params]
(reduce-kv (fn [params k v]
(let [sk (name k)]
(cond-> params
- (or (str/starts-with? sk "pm_")
- (str/starts-with? sk "pm-")
- (str/starts-with? sk "utm_"))
- (assoc (-> sk str/kebab keyword) v))))
+ (str/starts-with? sk "utm_")
+ (assoc (->> sk str/kebab (keyword "penpot")) v))))
{}
params))
@@ -210,7 +216,7 @@
(defn- auth-handler
[{:keys [tokens] :as cfg} {:keys [params] :as request}]
(let [invitation (:invitation-token params)
- props (extract-props params)
+ props (extract-utm-props params)
state (tokens :generate
{:iss :oauth
:invitation-token invitation
diff --git a/backend/src/app/http/session.clj b/backend/src/app/http/session.clj
index acff16136..6b9a566fd 100644
--- a/backend/src/app/http/session.clj
+++ b/backend/src/app/http/session.clj
@@ -8,11 +8,11 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.config :as cfg]
[app.db :as db]
[app.metrics :as mtx]
[app.util.async :as aa]
- [app.util.logging :as l]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.core.async :as a]
@@ -53,7 +53,12 @@
(defn- add-cookies
[response {:keys [id] :as session}]
- (assoc response :cookies {cookie-name {:path "/" :http-only true :value id}}))
+ (let [cors? (contains? cfg/flags :cors)]
+ (assoc response :cookies {cookie-name {:path "/"
+ :http-only true
+ :value id
+ :same-site (if cors? :none :strict)
+ :secure true}})))
(defn- clear-cookies
[response]
diff --git a/backend/src/app/loggers/audit.clj b/backend/src/app/loggers/audit.clj
index 5f19403de..e312ebba2 100644
--- a/backend/src/app/loggers/audit.clj
+++ b/backend/src/app/loggers/audit.clj
@@ -9,6 +9,7 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.common.transit :as t]
[app.common.uuid :as uuid]
@@ -16,7 +17,6 @@
[app.db :as db]
[app.util.async :as aa]
[app.util.http :as http]
- [app.util.logging :as l]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.core.async :as a]
@@ -36,6 +36,7 @@
[profile]
(-> profile
(select-keys [:is-active :is-muted :auth-backend :email :default-team-id :default-project-id :fullname :lang])
+ (merge (:props profile))
(d/without-nils)))
(defn clean-props
@@ -88,9 +89,9 @@
(s/def ::events (s/every ::event))
(defmethod ig/init-key ::http-handler
- [_ {:keys [executor enabled] :as cfg}]
- (fn [{:keys [params _headers _cookies profile-id] :as request}]
- (when enabled
+ [_ {:keys [executor] :as cfg}]
+ (fn [{:keys [params profile-id] :as request}]
+ (when (contains? cf/flags :audit-log)
(let [events (->> (:events params)
(remove #(not= profile-id (:profile-id %)))
(us/conform ::events))
@@ -137,10 +138,9 @@
;; an external storage and data cleared.
(declare persist-events)
-(s/def ::enabled ::us/boolean)
(defmethod ig/pre-init-spec ::collector [_]
- (s/keys :req-un [::db/pool ::wrk/executor ::enabled]))
+ (s/keys :req-un [::db/pool ::wrk/executor]))
(def event-xform
(comp
@@ -148,9 +148,9 @@
(map clean-props)))
(defmethod ig/init-key ::collector
- [_ {:keys [enabled] :as cfg}]
- (when enabled
- (l/info :msg "intializing audit collector")
+ [_ cfg]
+ (when (contains? cf/flags :audit-log)
+ (l/info :msg "intializing audit log collector")
(let [input (a/chan 512 event-xform)
buffer (aa/batch input {:max-batch-size 100
:max-batch-age (* 10 1000) ; 10s
@@ -204,15 +204,16 @@
(s/def ::tokens fn?)
(defmethod ig/pre-init-spec ::archive-task [_]
- (s/keys :req-un [::db/pool ::tokens ::enabled]
+ (s/keys :req-un [::db/pool ::tokens]
:opt-un [::uri]))
(defmethod ig/init-key ::archive-task
- [_ {:keys [uri enabled] :as cfg}]
+ [_ {:keys [uri] :as cfg}]
(fn [props]
;; NOTE: this let allows overwrite default configured values from
;; the repl, when manually invoking the task.
- (let [enabled (or enabled (:enabled props false))
+ (let [enabled (or (contains? cf/flags :audit-log-archive)
+ (:enabled props false))
uri (or uri (:uri props))
cfg (assoc cfg :uri uri)]
(when (and enabled (not uri))
@@ -271,11 +272,12 @@
:headers headers
:body body}
resp (http/send! params)]
- (when (not= (:status resp) 204)
- (ex/raise :type :internal
- :code :unable-to-send-events
- :hint "unable to send events"
- :context resp))))
+ (if (= (:status resp) 204)
+ true
+ (do
+ (l/warn :hint "unable to archive events"
+ :resp-status (:status resp))
+ false))))
(mark-as-archived [conn rows]
(db/exec-one! conn ["update audit_log set archived_at=now() where id = ANY(?)"
@@ -290,26 +292,14 @@
events (into [] xform rows)]
(when-not (empty? events)
(l/debug :action "archive-events" :uri uri :events (count events))
- (send events)
- (mark-as-archived conn rows)
- :continue)))))
+ (when (send events)
+ (mark-as-archived conn rows)
+ :continue))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GC Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(declare clean-archived)
-
-(s/def ::max-age ::cf/audit-archive-gc-max-age)
-
-(defmethod ig/pre-init-spec ::archive-gc-task [_]
- (s/keys :req-un [::db/pool ::enabled ::max-age]))
-
-(defmethod ig/init-key ::archive-gc-task
- [_ cfg]
- (fn [_]
- (clean-archived cfg)))
-
(def sql:clean-archived
"delete from audit_log
where archived_at is not null
@@ -322,3 +312,13 @@
result (:next.jdbc/update-count result)]
(l/debug :action "clean archived audit log" :removed result)
result))
+
+(s/def ::max-age ::cf/audit-log-gc-max-age)
+
+(defmethod ig/pre-init-spec ::gc-task [_]
+ (s/keys :req-un [::db/pool ::max-age]))
+
+(defmethod ig/init-key ::gc-task
+ [_ cfg]
+ (fn [_]
+ (clean-archived cfg)))
diff --git a/backend/src/app/loggers/database.clj b/backend/src/app/loggers/database.clj
new file mode 100644
index 000000000..2685661d8
--- /dev/null
+++ b/backend/src/app/loggers/database.clj
@@ -0,0 +1,126 @@
+;; 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.loggers.database
+ "A specific logger impl that persists errors on the database."
+ (:require
+ [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.util.async :as aa]
+ [app.util.template :as tmpl]
+ [app.worker :as wrk]
+ [clojure.core.async :as a]
+ [clojure.java.io :as io]
+ [clojure.spec.alpha :as s]
+ [cuerdas.core :as str]
+ [integrant.core :as ig]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Error Listener
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare handle-event)
+
+(defonce enabled (atom true))
+
+(defn- persist-on-database!
+ [{:keys [pool] :as cfg} {:keys [id] :as event}]
+ (db/with-atomic [conn pool]
+ (db/insert! conn :server-error-report
+ {:id id :content (db/tjson event)})))
+
+(defn- parse-context
+ [event]
+ (reduce-kv
+ (fn [acc k v]
+ (cond
+ (= k :id) (assoc acc k (uuid/uuid v))
+ (= k :profile-id) (assoc acc k (uuid/uuid v))
+ (str/blank? v) acc
+ :else (assoc acc k v)))
+ {}
+ (:context event)))
+
+(defn parse-event
+ [event]
+ (-> (parse-context event)
+ (merge (dissoc event :context))
+ (assoc :tenant (cf/get :tenant))
+ (assoc :host (cf/get :host))
+ (assoc :public-uri (cf/get :public-uri))
+ (assoc :version (:full cf/version))))
+
+(defn handle-event
+ [{:keys [executor] :as cfg} event]
+ (aa/with-thread executor
+ (try
+ (let [event (parse-event event)]
+ (persist-on-database! cfg event))
+ (catch Exception e
+ (l/warn :hint "unexpected exception on database error logger"
+ :cause e)))))
+
+(defmethod ig/pre-init-spec ::reporter [_]
+ (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
+
+(defmethod ig/init-key ::reporter
+ [_ {:keys [receiver] :as cfg}]
+ (l/info :msg "initializing database error persistence")
+ (let [output (a/chan (a/sliding-buffer 128)
+ (filter #(= (:level %) "error")))]
+ (receiver :sub output)
+ (a/go-loop []
+ (let [msg (a/ (io/resource "error-report.tmpl")
+ (tmpl/render content)))]
+
+
+ (fn [request]
+ (let [result (some-> (parse-id request)
+ (retrieve-report)
+ (render-template))]
+ (if result
+ {:status 200
+ :headers {"content-type" "text/html; charset=utf-8"
+ "x-robots-tag" "noindex"}
+ :body result}
+ {:status 404
+ :body "not found"})))))
diff --git a/backend/src/app/loggers/loki.clj b/backend/src/app/loggers/loki.clj
index 7344bad1f..5f6980d32 100644
--- a/backend/src/app/loggers/loki.clj
+++ b/backend/src/app/loggers/loki.clj
@@ -7,12 +7,12 @@
(ns app.loggers.loki
"A Loki integration."
(:require
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cfg]
[app.util.async :as aa]
[app.util.http :as http]
[app.util.json :as json]
- [app.util.logging :as l]
[app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
diff --git a/backend/src/app/loggers/mattermost.clj b/backend/src/app/loggers/mattermost.clj
index f4a60e5c1..ca23b9229 100644
--- a/backend/src/app/loggers/mattermost.clj
+++ b/backend/src/app/loggers/mattermost.clj
@@ -7,32 +7,51 @@
(ns app.loggers.mattermost
"A mattermost integration for error reporting."
(:require
- [app.common.exceptions :as ex]
- [app.common.spec :as us]
- [app.common.uuid :as uuid]
- [app.config :as cfg]
+ [app.common.logging :as l]
+ [app.config :as cf]
[app.db :as db]
+ [app.loggers.database :as ldb]
[app.util.async :as aa]
[app.util.http :as http]
[app.util.json :as json]
- [app.util.logging :as l]
- [app.util.template :as tmpl]
[app.worker :as wrk]
[clojure.core.async :as a]
- [clojure.java.io :as io]
[clojure.spec.alpha :as s]
- [cuerdas.core :as str]
[integrant.core :as ig]))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Error Listener
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defonce enabled (atom true))
-(declare handle-event)
+(defn- send-mattermost-notification!
+ [cfg {:keys [host id public-uri] :as event}]
+ (try
+ (let [uri (:uri cfg)
+ text (str "Exception on (host: " host ", url: " public-uri "/dbg/error-by-id/" id ")\n"
+ (when-let [pid (:profile-id event)]
+ (str "- profile-id: #uuid-" pid "\n")))
+ rsp (http/send! {:uri uri
+ :method :post
+ :headers {"content-type" "application/json"}
+ :body (json/encode-str {:text text})})]
+ (when (not= (:status rsp) 200)
+ (l/error :hint "error on sending data to mattermost"
+ :response (pr-str rsp))))
-(defonce enabled-mattermost (atom true))
+ (catch Exception e
+ (l/error :hint "unexpected exception on error reporter"
+ :cause e))))
-(s/def ::uri ::us/string)
+(defn handle-event
+ [{:keys [executor] :as cfg} event]
+ (aa/with-thread executor
+ (try
+ (let [event (ldb/parse-event event)]
+ (when @enabled
+ (send-mattermost-notification! cfg event)))
+ (catch Exception e
+ (l/warn :hint "unexpected exception on error reporter" :cause e)))))
+
+
+(s/def ::uri ::cf/error-report-webhook)
(defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req-un [::wrk/executor ::db/pool ::receiver]
@@ -58,95 +77,3 @@
[_ output]
(when output
(a/close! output)))
-
-(defn- send-mattermost-notification!
- [cfg {:keys [host id] :as cdata}]
- (try
- (let [uri (:uri cfg)
- text (str "Unhandled exception (host: " host ", url: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
- "- profile-id: #" (:profile-id cdata) "\n")
- rsp (http/send! {:uri uri
- :method :post
- :headers {"content-type" "application/json"}
- :body (json/encode-str {:text text})})]
- (when (not= (:status rsp) 200)
- (l/error :hint "error on sending data to mattermost"
- :response (pr-str rsp))))
-
- (catch Exception e
- (l/error :hint "unexpected exception on error reporter"
- :cause e))))
-
-(defn- persist-on-database!
- [{:keys [pool] :as cfg} {:keys [id] :as cdata}]
- (db/with-atomic [conn pool]
- (db/insert! conn :server-error-report
- {:id id :content (db/tjson cdata)})))
-
-(defn- parse-context
- [event]
- (reduce-kv
- (fn [acc k v]
- (cond
- (= k :id) (assoc acc k (uuid/uuid v))
- (= k :profile-id) (assoc acc k (uuid/uuid v))
- (str/blank? v) acc
- :else (assoc acc k v)))
- {:id (uuid/next)}
- (:context event)))
-
-(defn- parse-event
- [event]
- (-> (parse-context event)
- (merge (dissoc event :context))
- (assoc :tenant (cfg/get :tenant))
- (assoc :host (cfg/get :host))
- (assoc :public-uri (cfg/get :public-uri))
- (assoc :version (:full cfg/version))))
-
-(defn handle-event
- [{:keys [executor] :as cfg} event]
- (aa/with-thread executor
- (try
- (let [cdata (parse-event event)]
- (when @enabled-mattermost
- (send-mattermost-notification! cfg cdata))
- (persist-on-database! cfg cdata))
- (catch Exception e
- (l/error :hint "unexpected exception on error reporter"
- :cause e)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod ig/pre-init-spec ::handler [_]
- (s/keys :req-un [::db/pool]))
-
-(defmethod ig/init-key ::handler
- [_ {:keys [pool] :as cfg}]
- (letfn [(parse-id [request]
- (let [id (get-in request [:path-params :id])
- id (us/uuid-conformer id)]
- (when (uuid? id)
- id)))
- (retrieve-report [id]
- (ex/ignoring
- (when-let [{:keys [content] :as row} (db/get-by-id pool :server-error-report id)]
- (assoc row :content (db/decode-transit-pgobject content)))))
-
- (render-template [{:keys [content] :as report}]
- (some-> (io/resource "error-report.tmpl")
- (tmpl/render content)))]
-
-
- (fn [request]
- (let [result (some-> (parse-id request)
- (retrieve-report)
- (render-template))]
- (if result
- {:status 200
- :headers {"content-type" "text/html; charset=utf-8"}
- :body result}
- {:status 404
- :body "not found"})))))
diff --git a/backend/src/app/loggers/sentry.clj b/backend/src/app/loggers/sentry.clj
new file mode 100644
index 000000000..78ac1ee39
--- /dev/null
+++ b/backend/src/app/loggers/sentry.clj
@@ -0,0 +1,172 @@
+;; 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.loggers.sentry
+ "A mattermost integration for error reporting."
+ (:require
+ [app.common.logging :as l]
+ [app.common.uuid :as uuid]
+ [app.config :as cf]
+ [app.db :as db]
+ [app.util.async :as aa]
+ [app.worker :as wrk]
+ [clojure.core.async :as a]
+ [clojure.spec.alpha :as s]
+ [cuerdas.core :as str]
+ [integrant.core :as ig])
+ (:import
+ io.sentry.Scope
+ io.sentry.IHub
+ io.sentry.Hub
+ io.sentry.NoOpHub
+ io.sentry.protocol.User
+ io.sentry.SentryOptions
+ io.sentry.SentryLevel
+ io.sentry.ScopeCallback))
+
+(defonce enabled (atom true))
+
+(defn- parse-context
+ [event]
+ (reduce-kv
+ (fn [acc k v]
+ (cond
+ (= k :id) (assoc acc k (uuid/uuid v))
+ (= k :profile-id) (assoc acc k (uuid/uuid v))
+ (str/blank? v) acc
+ :else (assoc acc k v)))
+ {}
+ (:context event)))
+
+(defn- parse-event
+ [event]
+ (assoc event :context (parse-context event)))
+
+(defn- build-sentry-options
+ [cfg]
+ (let [version (:base cf/version)]
+ (doto (SentryOptions.)
+ (.setDebug (:debug cfg false))
+ (.setTracesSampleRate (:traces-sample-rate cfg 1.0))
+ (.setDsn (:dsn cfg))
+ (.setServerName (cf/get :host))
+ (.setEnvironment (cf/get :tenant))
+ (.setAttachServerName true)
+ (.setAttachStacktrace (:attach-stack-trace cfg false))
+ (.setRelease (str "backend@" (if (= version "0.0.0") "develop" version))))))
+
+(defn handle-event
+ [^IHub shub event]
+ (letfn [(set-user! [^Scope scope {:keys [context] :as event}]
+ (let [user (User.)]
+ (.setIpAddress ^User user ^String (:ip-addr context))
+ (when-let [pid (:profile-id context)]
+ (.setId ^User user ^String (str pid)))
+ (.setUser scope ^User user)))
+
+ (set-level! [^Scope scope]
+ (.setLevel scope SentryLevel/ERROR))
+
+ (set-context! [^Scope scope {:keys [context] :as event}]
+ (let [uri (str (cf/get :public-uri) "/dbg/error-by-id/" (:id context))]
+ (.setContexts scope "detailed_error_uri" ^String uri))
+ (when-let [vers (:frontend-version event)]
+ (.setContexts scope "frontend_version" ^String vers))
+ (when-let [puri (:public-uri event)]
+ (.setContexts scope "public_uri" ^String (str puri)))
+ (when-let [uagent (:user-agent context)]
+ (.setContexts scope "user_agent" ^String uagent))
+ (when-let [tenant (:tenant event)]
+ (.setTag scope "tenant" ^String tenant))
+ (when-let [type (:error-type context)]
+ (.setTag scope "error_type" ^String (str type)))
+ (when-let [code (:error-code context)]
+ (.setTag scope "error_code" ^String (str code)))
+ )
+
+ (capture [^Scope scope {:keys [context error] :as event}]
+ (let [msg (str (:message error) "\n\n"
+
+ "======================================================\n"
+ "=================== Params ===========================\n"
+ "======================================================\n"
+
+ (:params context) "\n"
+
+ (when (:explain context)
+ (str "======================================================\n"
+ "=================== Explain ==========================\n"
+ "======================================================\n"
+ (:explain context) "\n"))
+
+ (when (:data context)
+ (str "======================================================\n"
+ "=================== Error Data =======================\n"
+ "======================================================\n"
+ (:data context) "\n"))
+
+ (str "======================================================\n"
+ "=================== Stack Trace ======================\n"
+ "======================================================\n"
+ (:trace error))
+
+ "\n")]
+ (set-user! scope event)
+ (set-level! scope)
+ (set-context! scope event)
+ (.captureMessage ^IHub shub msg)
+ ))
+ ]
+ ;; (clojure.pprint/pprint event)
+
+ (when @enabled
+ (.withScope ^IHub shub (reify ScopeCallback
+ (run [_ scope]
+ (->> event
+ (parse-event)
+ (capture scope))))))
+
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Error Listener
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::receiver any?)
+(s/def ::dsn ::cf/sentry-dsn)
+(s/def ::trace-sample-rate ::cf/sentry-trace-sample-rate)
+(s/def ::attach-stack-trace ::cf/sentry-attach-stack-trace)
+(s/def ::debug ::cf/sentry-debug)
+
+(defmethod ig/pre-init-spec ::reporter [_]
+ (s/keys :req-un [::wrk/executor ::db/pool ::receiver]
+ :opt-un [::dsn ::trace-sample-rate ::attach-stack-trace]))
+
+(defmethod ig/init-key ::reporter
+ [_ {:keys [receiver dsn executor] :as cfg}]
+ (l/info :msg "initializing sentry reporter" :dsn dsn)
+ (let [opts (build-sentry-options cfg)
+ shub (if dsn
+ (Hub. ^SentryOptions opts)
+ (NoOpHub/getInstance))
+ output (a/chan (a/sliding-buffer 128)
+ (filter #(= (:level %) "error")))]
+ (receiver :sub output)
+ (a/go-loop []
+ (let [event (a/ path slurp svg/parse get-basic-info-from-svg)]
+ (let [info (some-> path slurp svg/pre-process svg/parse get-basic-info-from-svg)]
(when-not info
(ex/raise :type :validation
:code :invalid-svg-file
diff --git a/backend/src/app/metrics.clj b/backend/src/app/metrics.clj
index 148e9b3a2..b1d0033e6 100644
--- a/backend/src/app/metrics.clj
+++ b/backend/src/app/metrics.clj
@@ -7,7 +7,7 @@
(ns app.metrics
(:require
[app.common.exceptions :as ex]
- [app.util.logging :as l]
+ [app.common.logging :as l]
[clojure.spec.alpha :as s]
[integrant.core :as ig])
(:import
diff --git a/backend/src/app/msgbus.clj b/backend/src/app/msgbus.clj
index f7a013f72..146da0c83 100644
--- a/backend/src/app/msgbus.clj
+++ b/backend/src/app/msgbus.clj
@@ -8,10 +8,10 @@
"The msgbus abstraction implemented using redis as underlying backend."
(:require
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cfg]
[app.util.blob :as blob]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
diff --git a/backend/src/app/notifications.clj b/backend/src/app/notifications.clj
index f7efa6f3f..62490b212 100644
--- a/backend/src/app/notifications.clj
+++ b/backend/src/app/notifications.clj
@@ -7,12 +7,12 @@
(ns app.notifications
"A websocket based notifications mechanism."
(:require
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.common.transit :as t]
[app.db :as db]
[app.metrics :as mtx]
[app.util.async :as aa]
- [app.util.logging :as l]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.core.async :as a]
@@ -69,6 +69,7 @@
:mtx-messages mtx-messages
:mtx-sessions mtx-sessions
)]
+
(-> #(handler cfg %)
(wrap-session)
(wrap-keyword-params)
diff --git a/backend/src/app/rpc.clj b/backend/src/app/rpc.clj
index d77f83e3e..724b527aa 100644
--- a/backend/src/app/rpc.clj
+++ b/backend/src/app/rpc.clj
@@ -8,12 +8,12 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.db :as db]
[app.loggers.audit :as audit]
[app.metrics :as mtx]
[app.rlimits :as rlm]
- [app.util.logging :as l]
[app.util.services :as sv]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
@@ -97,36 +97,39 @@
auth? (:auth mdata true)]
(l/trace :action "register" :name (::sv/name mdata))
- (fn [params]
+ (with-meta
+ (fn [params]
- ;; Raise authentication error when rpc method requires auth but
- ;; no profile-id is found in the request.
- (when (and auth? (not (uuid? (:profile-id params))))
- (ex/raise :type :authentication
- :code :authentication-required
- :hint "authentication required for this endpoint"))
+ ;; Raise authentication error when rpc method requires auth but
+ ;; no profile-id is found in the request.
+ (when (and auth? (not (uuid? (:profile-id params))))
+ (ex/raise :type :authentication
+ :code :authentication-required
+ :hint "authentication required for this endpoint"))
- (let [params' (dissoc params ::request)
- params' (us/conform spec params')
- result (f cfg params')]
+ (let [params' (dissoc params ::request)
+ params' (us/conform spec params')
+ result (f cfg params')]
- ;; When audit log is enabled (default false).
- (when (fn? audit)
- (let [resultm (meta result)
- request (::request params)
- profile-id (or (:profile-id params')
- (:profile-id result)
- (::audit/profile-id resultm))
- props (d/merge params' (::audit/props resultm))]
- (audit :cmd :submit
- :type (::type cfg)
- :name (or (::audit/name resultm)
- (::sv/name mdata))
- :profile-id profile-id
- :ip-addr (audit/parse-client-ip request)
- :props props)))
+ ;; When audit log is enabled (default false).
+ (when (fn? audit)
+ (let [resultm (meta result)
+ request (::request params)
+ profile-id (or (:profile-id params')
+ (:profile-id result)
+ (::audit/profile-id resultm))
+ props (d/merge params' (::audit/props resultm))]
+ (audit :cmd :submit
+ :type (or (::audit/type resultm)
+ (::type cfg))
+ :name (or (::audit/name resultm)
+ (::sv/name mdata))
+ :profile-id profile-id
+ :ip-addr (audit/parse-client-ip request)
+ :props props)))
- result))))
+ result))
+ mdata)))
(defn- process-method
[cfg vfn]
@@ -148,10 +151,8 @@
'app.rpc.queries.teams
'app.rpc.queries.comments
'app.rpc.queries.profile
- 'app.rpc.queries.recent-files
'app.rpc.queries.viewer
- 'app.rpc.queries.fonts
- 'app.rpc.queries.svg)
+ 'app.rpc.queries.fonts)
(map (partial process-method cfg))
(into {}))))
@@ -170,7 +171,6 @@
'app.rpc.mutations.files
'app.rpc.mutations.comments
'app.rpc.mutations.projects
- 'app.rpc.mutations.viewer
'app.rpc.mutations.teams
'app.rpc.mutations.management
'app.rpc.mutations.ldap
diff --git a/backend/src/app/rpc/mutations/demo.clj b/backend/src/app/rpc/mutations/demo.clj
index fc7f184bf..cca26dbb4 100644
--- a/backend/src/app/rpc/mutations/demo.clj
+++ b/backend/src/app/rpc/mutations/demo.clj
@@ -9,7 +9,7 @@
(:require
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
- [app.config :as cfg]
+ [app.config :as cf]
[app.db :as db]
[app.loggers.audit :as audit]
[app.rpc.mutations.profile :as profile]
@@ -35,11 +35,11 @@
:email email
:fullname fullname
:is-demo true
- :deleted-at (dt/in-future cfg/deletion-delay)
+ :deleted-at (dt/in-future cf/deletion-delay)
:password password
:props {:onboarding-viewed true}}]
- (when-not (cfg/get :allow-demo-users)
+ (when-not (contains? cf/flags :demo-users)
(ex/raise :type :validation
:code :demo-users-not-allowed
:hint "Demo users are disabled by config."))
diff --git a/backend/src/app/rpc/mutations/fonts.clj b/backend/src/app/rpc/mutations/fonts.clj
index 85c604b15..b9682dad2 100644
--- a/backend/src/app/rpc/mutations/fonts.clj
+++ b/backend/src/app/rpc/mutations/fonts.clj
@@ -9,14 +9,12 @@
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
- [app.config :as cf]
[app.db :as db]
[app.media :as media]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
[app.util.services :as sv]
[app.util.time :as dt]
- [app.worker :as wrk]
[clojure.spec.alpha :as s]))
(declare create-font-variant)
@@ -129,13 +127,6 @@
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
- ;; Schedule object deletion
- (wrk/submit! {::wrk/task :delete-object
- ::wrk/delay cf/deletion-delay
- ::wrk/conn conn
- :id id
- :type :team-font-variant})
-
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id id :team-id team-id})
diff --git a/backend/src/app/rpc/mutations/ldap.clj b/backend/src/app/rpc/mutations/ldap.clj
index d982a30b0..0f6675f24 100644
--- a/backend/src/app/rpc/mutations/ldap.clj
+++ b/backend/src/app/rpc/mutations/ldap.clj
@@ -7,13 +7,13 @@
(ns app.rpc.mutations.ldap
(:require
[app.common.exceptions :as ex]
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.loggers.audit :as audit]
[app.rpc.mutations.profile :as profile-m]
[app.rpc.queries.profile :as profile-q]
- [app.util.logging :as l]
[app.util.services :as sv]
[clj-ldap.client :as ldap]
[clojure.spec.alpha :as s]
diff --git a/backend/src/app/rpc/mutations/management.clj b/backend/src/app/rpc/mutations/management.clj
index 1cf111729..76d997fee 100644
--- a/backend/src/app/rpc/mutations/management.clj
+++ b/backend/src/app/rpc/mutations/management.clj
@@ -39,11 +39,23 @@
[file index]
(letfn [(process-form [form]
(cond-> form
- ;; Relink Components
+ ;; Relink library items
(and (map? form)
(uuid? (:component-file form)))
(update :component-file #(get index % %))
+ (and (map? form)
+ (uuid? (:fill-color-ref-file form)))
+ (update :fill-color-ref-file #(get index % %))
+
+ (and (map? form)
+ (uuid? (:stroke-color-ref-file form)))
+ (update :stroke-color-ref-file #(get index % %))
+
+ (and (map? form)
+ (uuid? (:typography-ref-file form)))
+ (update :typography-ref-file #(get index % %))
+
;; Relink Image Shapes
(and (map? form)
(map? (:metadata form))
diff --git a/backend/src/app/rpc/mutations/profile.clj b/backend/src/app/rpc/mutations/profile.clj
index 099092ba5..906ec83ad 100644
--- a/backend/src/app/rpc/mutations/profile.clj
+++ b/backend/src/app/rpc/mutations/profile.clj
@@ -12,7 +12,7 @@
[app.config :as cf]
[app.db :as db]
[app.emails :as eml]
- [app.http.oauth :refer [extract-props]]
+ [app.http.oauth :refer [extract-utm-props]]
[app.loggers.audit :as audit]
[app.media :as media]
[app.metrics :as mtx]
@@ -100,10 +100,9 @@
(sv/defmethod ::prepare-register-profile {:auth false}
[{:keys [pool tokens] :as cfg} params]
- (when-not (cf/get :registration-enabled)
+ (when-not (contains? cf/flags :registration)
(ex/raise :type :restriction
:code :registration-disabled))
-
(when-let [domains (cf/get :registration-domain-whitelist)]
(when-not (email-domain-in-whitelist? domains (:email params))
(ex/raise :type :validation
@@ -128,23 +127,16 @@
;; --- MUTATION: Register Profile
(s/def ::accept-terms-and-privacy ::us/boolean)
-(s/def ::accept-newsletter-subscription ::us/boolean)
(s/def ::token ::us/not-empty-string)
(s/def ::register-profile
- (s/keys :req-un [::token ::fullname
- ::accept-terms-and-privacy]
- :opt-un [::accept-newsletter-subscription]))
+ (s/keys :req-un [::token ::fullname]))
(sv/defmethod ::register-profile {:auth false :rlimit :password}
[{:keys [pool] :as cfg} params]
- (when-not (:accept-terms-and-privacy params)
- (ex/raise :type :validation
- :code :invalid-terms-and-privacy))
-
(db/with-atomic [conn pool]
- (let [cfg (assoc cfg :conn conn)]
- (register-profile cfg params))))
+ (-> (assoc cfg :conn conn)
+ (register-profile params))))
(defn- annotate-profile-register
"A helper for properly increase the profile-register metric once the
@@ -163,6 +155,7 @@
(create-profile conn)
(create-profile-relations conn)
(decode-profile-row))]
+
(sid/load-initial-project! conn profile)
(cond
@@ -204,7 +197,6 @@
ptoken (tokens :generate-predefined
{:iss :profile-identity
:profile-id (:id profile)})]
-
(eml/send! {::eml/conn conn
::eml/factory eml/register
:public-uri (:public-uri cfg)
@@ -224,18 +216,17 @@
[conn params]
(let [id (or (:id params) (uuid/next))
- props (-> (extract-props params)
+ props (-> (extract-utm-props params)
(merge (:props params))
- (assoc :accept-terms-and-privacy (:accept-terms-and-privacy params true))
- (assoc :accept-newsletter-subscription (:accept-newsletter-subscription params false))
(db/tjson))
password (if-let [password (:password params)]
(derive-password password)
"!")
- locale (as-> (:locale params) locale
- (and (string? locale) (not (str/blank? locale)) locale))
+ locale (:locale params)
+ locale (when (and (string? locale) (not (str/blank? locale)))
+ locale)
backend (:backend params "penpot")
is-demo (:is-demo params false)
@@ -359,11 +350,14 @@
(defn- update-profile
[conn {:keys [id fullname lang theme] :as params}]
- (db/update! conn :profile
- {:fullname fullname
- :lang lang
- :theme theme}
- {:id id}))
+ (let [profile (db/update! conn :profile
+ {:fullname fullname
+ :lang lang
+ :theme theme}
+ {:id id})]
+ (-> profile
+ (profile/decode-profile-row)
+ (profile/strip-private-attrs))))
(s/def ::update-profile
(s/keys :req-un [::id ::fullname]
@@ -372,8 +366,9 @@
(sv/defmethod ::update-profile
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
- (update-profile conn params)
- nil))
+ (let [profile (update-profile conn params)]
+ (with-meta profile
+ {::audit/props (audit/profile->props profile)}))))
;; --- MUTATION: Update Password
@@ -458,7 +453,8 @@
params (assoc params
:profile profile
:email (str/lower email))]
- (if (cf/get :smtp-enabled)
+ (if (or (cf/get :smtp-enabled)
+ (contains? cf/flags :smtp))
(request-email-change cfg params)
(change-email-inmediatelly cfg params)))))
@@ -591,11 +587,15 @@
(db/with-atomic [conn pool]
(let [profile (profile/retrieve-profile-data conn profile-id)
props (reduce-kv (fn [props k v]
- (if (nil? v)
- (dissoc props k)
- (assoc props k v)))
+ ;; We don't accept namespaced keys
+ (if (simple-ident? k)
+ (if (nil? v)
+ (dissoc props k)
+ (assoc props k v))
+ props))
(:props profile)
props)]
+
(db/update! conn :profile
{:props (db/tjson props)}
{:id profile-id})
diff --git a/backend/src/app/rpc/mutations/share_link.clj b/backend/src/app/rpc/mutations/share_link.clj
index 0e366957f..6079ecf7d 100644
--- a/backend/src/app/rpc/mutations/share_link.clj
+++ b/backend/src/app/rpc/mutations/share_link.clj
@@ -31,6 +31,11 @@
:opt-un [::pages]))
(sv/defmethod ::create-share-link
+ "Creates a share-link object.
+
+ Share links are resources that allows external users access to
+ specific files with specific permissions (flags)."
+
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
diff --git a/backend/src/app/rpc/mutations/teams.clj b/backend/src/app/rpc/mutations/teams.clj
index 0d385fa2e..625a13af6 100644
--- a/backend/src/app/rpc/mutations/teams.clj
+++ b/backend/src/app/rpc/mutations/teams.clj
@@ -132,8 +132,8 @@
(sv/defmethod ::delete-team
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
- (let [perms (teams/check-edition-permissions! conn profile-id id)]
- (when-not (some :is-owner perms)
+ (let [perms (teams/get-permissions conn profile-id id)]
+ (when-not (:is-owner perms)
(ex/raise :type :validation
:code :only-owner-can-delete-team))
@@ -300,7 +300,7 @@
(sv/defmethod ::invite-team-member
[{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
(db/with-atomic [conn pool]
- (let [perms (teams/check-edition-permissions! conn profile-id team-id)
+ (let [perms (teams/get-permissions conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
member (profile/retrieve-profile-data-by-email conn email)
team (db/get-by-id conn :team team-id)
@@ -316,7 +316,7 @@
{:iss :profile-identity
:profile-id (:id profile)})]
- (when-not (some :is-admin perms)
+ (when-not (:is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
diff --git a/backend/src/app/rpc/mutations/verify_token.clj b/backend/src/app/rpc/mutations/verify_token.clj
index 61b5f9abb..1fa32b81d 100644
--- a/backend/src/app/rpc/mutations/verify_token.clj
+++ b/backend/src/app/rpc/mutations/verify_token.clj
@@ -9,6 +9,7 @@
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
+ [app.loggers.audit :as audit]
[app.metrics :as mtx]
[app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile]
@@ -63,7 +64,10 @@
(with-meta claims
{:transform-response ((:create session) profile-id)
- :before-complete (annotate-profile-activation metrics)})))
+ :before-complete (annotate-profile-activation metrics)
+ ::audit/name "verify-profile-email"
+ ::audit/props (audit/profile->props profile)
+ ::audit/profile-id (:id profile)})))
(defmethod process-token :auth
[{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
@@ -116,8 +120,7 @@
;; user is already logged in with some account.
(and (uuid? profile-id)
(uuid? member-id))
- (do
- (accept-invitation cfg claims)
+ (let [profile (accept-invitation cfg claims)]
(if (= member-id profile-id)
;; If the current session is already matches the invited
;; member, then just return the token and leave the frontend
@@ -131,27 +134,44 @@
;; account.
(with-meta
(assoc claims :state :created)
- {:transform-response ((:create session) member-id)})))
+ {:transform-response ((:create session) member-id)
+ ::audit/name "accept-team-invitation"
+ ::audit/props (merge
+ (audit/profile->props profile)
+ {:team-id (:team-id claims)
+ :role (:role claims)})
+ ::audit/profile-id profile-id})))
;; This happens when member-id is not filled in the invitation but
;; the user already has an account (probably with other mail) and
;; is already logged-in.
(and (uuid? profile-id)
(nil? member-id))
- (do
- (accept-invitation cfg (assoc claims :member-id profile-id))
- (assoc claims :state :created))
+ (let [profile (accept-invitation cfg (assoc claims :member-id profile-id))]
+ (with-meta
+ (assoc claims :state :created)
+ {::audit/name "accept-team-invitation"
+ ::audit/props (merge
+ (audit/profile->props profile)
+ {:team-id (:team-id claims)
+ :role (:role claims)})
+ ::audit/profile-id profile-id}))
;; This happens when member-id is filled but the accessing user is
;; not logged-in. In this case we proceed to accept invitation and
;; leave the user logged-in.
(and (nil? profile-id)
(uuid? member-id))
- (do
- (accept-invitation cfg claims)
+ (let [profile (accept-invitation cfg claims)]
(with-meta
(assoc claims :state :created)
- {:transform-response ((:create session) member-id)}))
+ {:transform-response ((:create session) member-id)
+ ::audit/name "accept-team-invitation"
+ ::audit/props (merge
+ (audit/profile->props profile)
+ {:team-id (:team-id claims)
+ :role (:role claims)})
+ ::audit/profile-id member-id}))
;; In this case, we wait until frontend app redirect user to
;; registeration page, the user is correctly registered and the
diff --git a/backend/src/app/rpc/mutations/viewer.clj b/backend/src/app/rpc/mutations/viewer.clj
deleted file mode 100644
index 85beafa96..000000000
--- a/backend/src/app/rpc/mutations/viewer.clj
+++ /dev/null
@@ -1,49 +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) UXBOX Labs SL
-
-(ns app.rpc.mutations.viewer
- (:require
- [app.common.spec :as us]
- [app.db :as db]
- [app.rpc.queries.files :as files]
- [app.util.services :as sv]
- [buddy.core.codecs :as bc]
- [buddy.core.nonce :as bn]
- [clojure.spec.alpha :as s]))
-
-(s/def ::profile-id ::us/uuid)
-(s/def ::file-id ::us/uuid)
-(s/def ::page-id ::us/uuid)
-
-(s/def ::create-file-share-token
- (s/keys :req-un [::profile-id ::file-id ::page-id]))
-
-(sv/defmethod ::create-file-share-token
- [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id] :as params}]
- (db/with-atomic [conn pool]
- (files/check-edition-permissions! conn profile-id file-id)
- (let [token (-> (bn/random-bytes 16)
- (bc/bytes->b64u)
- (bc/bytes->str))]
- (db/insert! conn :file-share-token
- {:file-id file-id
- :page-id page-id
- :token token})
- {:token token})))
-
-
-(s/def ::token ::us/not-empty-string)
-(s/def ::delete-file-share-token
- (s/keys :req-un [::profile-id ::file-id ::token]))
-
-(sv/defmethod ::delete-file-share-token
- [{:keys [pool] :as cfg} {:keys [profile-id file-id token]}]
- (db/with-atomic [conn pool]
- (files/check-edition-permissions! conn profile-id file-id)
- (db/delete! conn :file-share-token
- {:file-id file-id
- :token token})
- nil))
diff --git a/backend/src/app/rpc/permissions.clj b/backend/src/app/rpc/permissions.clj
index 9481bcd57..363f967e6 100644
--- a/backend/src/app/rpc/permissions.clj
+++ b/backend/src/app/rpc/permissions.clj
@@ -41,59 +41,24 @@
"A simple factory for edition permission predicate functions."
[qfn]
(us/assert fn? qfn)
- (fn [& args]
- (let [rows (apply qfn args)]
- (when-not (or (empty? rows)
- (not (or (some :can-edit rows)
- (some :is-admin rows)
- (some :is-owner rows))))
- rows))))
+ (fn check
+ ([perms] (:can-edit perms))
+ ([conn & args] (check (apply qfn conn args)))))
(defn make-read-predicate-fn
"A simple factory for read permission predicate functions."
[qfn]
(us/assert fn? qfn)
- (fn [& args]
- (let [rows (apply qfn args)]
- (when (seq rows)
- rows))))
+ (fn check
+ ([perms] (:can-read perms))
+ ([conn & args] (check (apply qfn conn args)))))
(defn make-check-fn
"Helper that converts a predicate permission function to a check
function (function that raises an exception)."
[pred]
(fn [& args]
- (when-not (seq (apply pred args))
+ (when-not (apply pred args)
(ex/raise :type :not-found
:code :object-not-found
:hint "not found"))))
-
-
-;; TODO: the following functions are deprecated and replaced with the
-;; new ones. Should not be used.
-
-(defn make-edition-check-fn
- "A simple factory for edition permission check functions."
- [qfn]
- (us/assert fn? qfn)
- (fn [& args]
- (let [rows (apply qfn args)]
- (if (or (empty? rows)
- (not (or (some :can-edit rows)
- (some :is-admin rows)
- (some :is-owner rows))))
- (ex/raise :type :not-found
- :code :object-not-found
- :hint "not found")
- rows))))
-
-(defn make-read-check-fn
- "A simple factory for read permission check functions."
- [qfn]
- (us/assert fn? qfn)
- (fn [& args]
- (let [rows (apply qfn args)]
- (if-not (seq rows)
- (ex/raise :type :not-found
- :code :object-not-found)
- rows))))
diff --git a/backend/src/app/rpc/queries/files.clj b/backend/src/app/rpc/queries/files.clj
index 032032216..7caff964b 100644
--- a/backend/src/app/rpc/queries/files.clj
+++ b/backend/src/app/rpc/queries/files.clj
@@ -12,6 +12,7 @@
[app.db :as db]
[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.storage.impl :as simpl]
[app.util.blob :as blob]
@@ -59,7 +60,7 @@
where f.id = ?
and ppr.profile_id = ?")
-(defn- retrieve-file-permissions
+(defn retrieve-file-permissions
[conn profile-id file-id]
(when (and profile-id file-id)
(db/exec! conn [sql:file-permissions
@@ -67,11 +68,37 @@
file-id profile-id
file-id profile-id])))
+(defn get-permissions
+ ([conn profile-id file-id]
+ (let [rows (retrieve-file-permissions conn profile-id file-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)
+ {:type :membership
+ :is-owner is-owner
+ :is-admin (or is-owner is-admin)
+ :can-edit (or is-owner is-admin can-edit)
+ :can-read true})))
+ ([conn profile-id file-id share-id]
+ (let [perms (get-permissions conn profile-id file-id)
+ ldata (retrieve-share-link conn file-id share-id)]
+
+ ;; NOTE: in a future when share-link becomes more powerfull and
+ ;; will allow us specify which parts of the app is availabel, we
+ ;; will probably need to tweak this function in order to expose
+ ;; this flags to the frontend.
+ (cond
+ (some? perms) perms
+ (some? ldata) {:type :share-link
+ :can-read true
+ :flags (:flags ldata)}))))
+
(def has-edit-permissions?
- (perms/make-edition-predicate-fn retrieve-file-permissions))
+ (perms/make-edition-predicate-fn get-permissions))
(def has-read-permissions?
- (perms/make-read-predicate-fn retrieve-file-permissions))
+ (perms/make-read-predicate-fn get-permissions))
(def check-edition-permissions!
(perms/make-check-fn has-edit-permissions?))
@@ -79,7 +106,6 @@
(def check-read-permissions!
(perms/make-check-fn has-read-permissions?))
-
;; --- Query: Files search
;; TODO: this query need to a good refactor
@@ -131,29 +157,6 @@
profile-id team-id
search-term])))
-
-;; --- Query: Files
-
-;; DEPRECATED: should be removed probably on 1.6.x
-
-(def ^:private sql:files
- "select f.*
- from file as f
- where f.project_id = ?
- and f.deleted_at is null
- order by f.modified_at desc")
-
-(s/def ::project-id ::us/uuid)
-(s/def ::files
- (s/keys :req-un [::profile-id ::project-id]))
-
-(sv/defmethod ::files
- [{: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)
- (into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
-
-
;; --- Query: Project Files
(def ^:private sql:project-files
@@ -201,11 +204,15 @@
(s/keys :req-un [::profile-id ::id]))
(sv/defmethod ::file
+ "Retrieve a file by its ID. Only authenticated users."
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
- (let [cfg (assoc cfg :conn conn)]
- (check-edition-permissions! conn profile-id id)
- (retrieve-file cfg id))))
+ (let [cfg (assoc cfg :conn conn)
+ perms (get-permissions conn profile-id id)]
+
+ (check-read-permissions! perms)
+ (some-> (retrieve-file cfg id)
+ (assoc :permissions perms)))))
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]))
@@ -240,7 +247,8 @@
(sv/defmethod ::page
[{:keys [pool] :as cfg} {:keys [profile-id file-id strip-thumbnails]}]
(db/with-atomic [conn pool]
- (check-edition-permissions! conn profile-id file-id)
+ (check-read-permissions! conn profile-id file-id)
+
(let [cfg (assoc cfg :conn conn)
file (retrieve-file cfg file-id)
page-id (get-in file [:data :pages 0])]
@@ -250,28 +258,6 @@
;; --- Query: Shared Library Files
-;; DEPRECATED: and will be removed on 1.6.x
-
-(def ^:private sql:shared-files
- "select f.*
- from file as f
- inner join project as p on (p.id = f.project_id)
- where f.is_shared = true
- and f.deleted_at is null
- and p.deleted_at is null
- and p.team_id = ?
- order by f.modified_at desc")
-
-(s/def ::shared-files
- (s/keys :req-un [::profile-id ::team-id]))
-
-(sv/defmethod ::shared-files
- [{:keys [pool] :as cfg} {:keys [team-id] :as params}]
- (into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
-
-
-;; --- Query: Shared Library Files
-
(def ^:private sql:team-shared-files
"select f.id,
f.project_id,
@@ -336,7 +322,7 @@
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg :conn conn)]
- (check-edition-permissions! conn profile-id file-id)
+ (check-read-permissions! conn profile-id file-id)
(retrieve-file-libraries cfg false file-id))))
;; --- QUERY: team-recent-files
diff --git a/backend/src/app/rpc/queries/profile.clj b/backend/src/app/rpc/queries/profile.clj
index 41f322881..6843a0719 100644
--- a/backend/src/app/rpc/queries/profile.clj
+++ b/backend/src/app/rpc/queries/profile.clj
@@ -70,6 +70,10 @@
[conn profile]
(merge profile (retrieve-additional-data conn (:id profile))))
+(defn- filter-profile-props
+ [props]
+ (into {} (filter (fn [[k _]] (simple-ident? k))) props))
+
(defn decode-profile-row
[{:keys [props] :as row}]
(cond-> row
@@ -90,7 +94,7 @@
(ex/raise :type :not-found
:hint "Object doest not exists."))
- profile))
+ (update profile :props filter-profile-props)))
(def ^:private sql:profile-by-email
"select p.* from profile as p
diff --git a/backend/src/app/rpc/queries/projects.clj b/backend/src/app/rpc/queries/projects.clj
index 29195ceb0..47886784a 100644
--- a/backend/src/app/rpc/queries/projects.clj
+++ b/backend/src/app/rpc/queries/projects.clj
@@ -31,18 +31,31 @@
where ppr.project_id = ?
and ppr.profile_id = ?")
-(defn- retrieve-project-permissions
+(defn- get-permissions
[conn profile-id project-id]
- (db/exec! conn [sql:project-permissions
- project-id profile-id
- project-id profile-id]))
+ (let [rows (db/exec! conn [sql:project-permissions
+ project-id profile-id
+ project-id profile-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-edition-check-fn retrieve-project-permissions))
+ (perms/make-check-fn has-edit-permissions?))
(def check-read-permissions!
- (perms/make-read-check-fn retrieve-project-permissions))
-
+ (perms/make-check-fn has-read-permissions?))
;; --- Query: Projects
diff --git a/backend/src/app/rpc/queries/recent_files.clj b/backend/src/app/rpc/queries/recent_files.clj
deleted file mode 100644
index e878d34e6..000000000
--- a/backend/src/app/rpc/queries/recent_files.clj
+++ /dev/null
@@ -1,42 +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) UXBOX Labs SL
-
-(ns app.rpc.queries.recent-files
- (:require
- [app.common.spec :as us]
- [app.db :as db]
- [app.rpc.queries.files :refer [decode-row-xf]]
- [app.rpc.queries.teams :as teams]
- [app.util.services :as sv]
- [clojure.spec.alpha :as s]))
-
-;; DEPRECATED: should be removed on 1.6.x
-
-(def sql:recent-files
- "with recent_files as (
- select f.*, row_number() over w as row_num
- from file as f
- join project as p on (p.id = f.project_id)
- where p.team_id = ?
- and p.deleted_at is null
- and f.deleted_at is null
- window w as (partition by f.project_id order by f.modified_at desc)
- order by f.modified_at desc
- )
- select * from recent_files where row_num <= 10;")
-
-(s/def ::team-id ::us/uuid)
-(s/def ::profile-id ::us/uuid)
-
-(s/def ::recent-files
- (s/keys :req-un [::profile-id ::team-id]))
-
-(sv/defmethod ::recent-files
- [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
- (with-open [conn (db/open pool)]
- (teams/check-read-permissions! conn profile-id team-id)
- (let [files (db/exec! conn [sql:recent-files team-id])]
- (into [] decode-row-xf files))))
diff --git a/backend/src/app/rpc/queries/share_link.clj b/backend/src/app/rpc/queries/share_link.clj
new file mode 100644
index 000000000..0bc567364
--- /dev/null
+++ b/backend/src/app/rpc/queries/share_link.clj
@@ -0,0 +1,23 @@
+;; 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.queries.share-link
+ (:require
+ [app.db :as db]))
+
+(defn decode-share-link-row
+ [row]
+ (-> row
+ (update :flags db/decode-pgarray #{})
+ (update :pages db/decode-pgarray #{})))
+
+(defn retrieve-share-link
+ [conn file-id share-id]
+ (some-> (db/get-by-params conn :share-link
+ {:id share-id :file-id file-id}
+ {:check-not-found false})
+ (decode-share-link-row)))
+
diff --git a/backend/src/app/rpc/queries/teams.clj b/backend/src/app/rpc/queries/teams.clj
index 7bad8ba59..407237237 100644
--- a/backend/src/app/rpc/queries/teams.clj
+++ b/backend/src/app/rpc/queries/teams.clj
@@ -24,16 +24,29 @@
where tpr.profile_id = ?
and tpr.team_id = ?")
-(defn- retrieve-team-permissions
+(defn get-permissions
[conn profile-id team-id]
- (db/exec! conn [sql:team-permissions 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-edition-check-fn retrieve-team-permissions))
+ (perms/make-check-fn has-edit-permissions?))
(def check-read-permissions!
- (perms/make-read-check-fn retrieve-team-permissions))
-
+ (perms/make-check-fn has-read-permissions?))
;; --- Query: Teams
@@ -58,12 +71,26 @@
join team as t on (t.id = tp.team_id)
where t.deleted_at is null
and tp.profile_id = ?
- order by t.created_at asc")
+ 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])))
+ (->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id])
+ (mapv process-permissions))))
;; --- Query: Team (by ID)
@@ -86,7 +113,7 @@
(when-not result
(ex/raise :type :not-found
:code :team-does-not-exist))
- result))
+ (process-permissions result)))
;; --- Query: Team Members
diff --git a/backend/src/app/rpc/queries/viewer.clj b/backend/src/app/rpc/queries/viewer.clj
index 2f5334d99..9d35f9e07 100644
--- a/backend/src/app/rpc/queries/viewer.clj
+++ b/backend/src/app/rpc/queries/viewer.clj
@@ -10,29 +10,17 @@
[app.common.spec :as us]
[app.db :as db]
[app.rpc.queries.files :as files]
+ [app.rpc.queries.share-link :as slnk]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Query: View Only Bundle
-(defn- decode-share-link-row
- [row]
- (-> row
- (update :flags db/decode-pgarray #{})
- (update :pages db/decode-pgarray #{})))
-
(defn- retrieve-project
[conn id]
(db/get-by-id conn :project id {:columns [:id :name :team-id]}))
-(defn- retrieve-share-link
- [{:keys [conn]} file-id id]
- (some-> (db/get-by-params conn :share-link
- {:id id :file-id file-id}
- {:check-not-found false})
- (decode-share-link-row)))
-
(defn- retrieve-bundle
[{:keys [conn] :as cfg} file-id]
(let [file (files/retrieve-file cfg file-id)
@@ -41,7 +29,7 @@
users (teams/retrieve-users conn (:team-id project))
links (->> (db/query conn :share-link {:file-id file-id})
- (mapv decode-share-link-row))
+ (mapv slnk/decode-share-link-row))
fonts (db/query conn :team-font-variant
{:team-id (:team-id project)
@@ -64,8 +52,11 @@
[{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg :conn conn)
- bundle (retrieve-bundle cfg file-id)
- slink (retrieve-share-link cfg file-id share-id)]
+ slink (slnk/retrieve-share-link conn file-id share-id)
+ perms (files/get-permissions conn profile-id file-id share-id)
+
+ bundle (some-> (retrieve-bundle cfg file-id)
+ (assoc :permissions perms))]
;; When we have neither profile nor share, we just return a not
;; found response to the user.
@@ -80,13 +71,6 @@
(files/check-read-permissions! conn profile-id file-id))
(cond-> bundle
- ;; If we have current profile, put
- (some? profile-id)
- (as-> $ (let [edit? (boolean (files/has-edit-permissions? conn profile-id file-id))
- read? (boolean (files/has-read-permissions? conn profile-id file-id))]
- (-> (assoc $ :permissions {:read read? :edit edit?})
- (cond-> (not edit?) (dissoc :share-links)))))
-
(some? slink)
(assoc :share slink)
@@ -97,61 +81,3 @@
(-> data
(update :pages (fn [pages] (filterv #(contains? allowed-pages %) pages)))
(update :pages-index (fn [index] (select-keys index allowed-pages)))))))))))
-
-;; --- Query: Viewer Bundle (by Page ID)
-
-;; DEPRECATED: should be removed in 1.9.x
-
-(declare check-shared-token!)
-(declare retrieve-shared-token)
-
-(s/def ::id ::us/uuid)
-(s/def ::page-id ::us/uuid)
-(s/def ::token ::us/string)
-
-(s/def ::viewer-bundle
- (s/keys :req-un [::file-id ::page-id]
- :opt-un [::profile-id ::token]))
-
-(sv/defmethod ::viewer-bundle {:auth false}
- [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id token] :as params}]
- (db/with-atomic [conn pool]
- (let [cfg (assoc cfg :conn conn)
- file (files/retrieve-file cfg file-id)
- project (retrieve-project conn (:project-id file))
- page (get-in file [:data :pages-index page-id])
- file (merge (dissoc file :data)
- (select-keys (:data file) [:colors :media :typographies]))
- libs (files/retrieve-file-libraries cfg false file-id)
- users (teams/retrieve-users conn (:team-id project))
-
- fonts (db/query conn :team-font-variant
- {:team-id (:team-id project)
- :deleted-at nil})
-
- bundle {:file file
- :page page
- :users users
- :fonts fonts
- :project project
- :libraries libs}]
-
- (if (string? token)
- (do
- (check-shared-token! conn file-id page-id token)
- (assoc bundle :token token))
- (let [stoken (retrieve-shared-token conn file-id page-id)]
- (files/check-read-permissions! conn profile-id file-id)
- (assoc bundle :token (:token stoken)))))))
-
-(defn check-shared-token!
- [conn file-id page-id token]
- (let [sql "select exists(select 1 from file_share_token where file_id=? and page_id=? and token=?) as exists"]
- (when-not (:exists (db/exec-one! conn [sql file-id page-id token]))
- (ex/raise :type :not-found
- :code :object-not-found))))
-
-(defn retrieve-shared-token
- [conn file-id page-id]
- (let [sql "select * from file_share_token where file_id=? and page_id=?"]
- (db/exec-one! conn [sql file-id page-id])))
diff --git a/backend/src/app/srepl.clj b/backend/src/app/srepl.clj
index 9d7c6c825..e71a2ac26 100644
--- a/backend/src/app/srepl.clj
+++ b/backend/src/app/srepl.clj
@@ -7,9 +7,9 @@
(ns app.srepl
"Server Repl."
(:require
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.srepl.main]
- [app.util.logging :as l]
[clojure.core.server :as ccs]
[clojure.main :as cm]
[clojure.spec.alpha :as s]
diff --git a/backend/src/app/storage.clj b/backend/src/app/storage.clj
index e6acb0776..a06c228e5 100644
--- a/backend/src/app/storage.clj
+++ b/backend/src/app/storage.clj
@@ -9,6 +9,7 @@
(: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.db :as db]
@@ -16,7 +17,6 @@
[app.storage.fs :as sfs]
[app.storage.impl :as impl]
[app.storage.s3 :as ss3]
- [app.util.logging :as l]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
diff --git a/backend/src/app/tasks/delete_object.clj b/backend/src/app/tasks/delete_object.clj
deleted file mode 100644
index b1b3e701b..000000000
--- a/backend/src/app/tasks/delete_object.clj
+++ /dev/null
@@ -1,70 +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) UXBOX Labs SL
-
-;; TODO: DEPRECATED
-;; Should be removed in the 1.8.x
-
-(ns app.tasks.delete-object
- "Generic task for permanent deletion of objects."
- (:require
- [app.common.data :as d]
- [app.common.spec :as us]
- [app.db :as db]
- [app.storage :as sto]
- [app.util.logging :as l]
- [clojure.spec.alpha :as s]
- [integrant.core :as ig]))
-
-(declare handle-deletion)
-
-(defmethod ig/pre-init-spec ::handler [_]
- (s/keys :req-un [::db/pool ::sto/storage]))
-
-(defmethod ig/init-key ::handler
- [_ {:keys [pool] :as cfg}]
- (fn [{:keys [props] :as task}]
- (us/verify ::props props)
- (db/with-atomic [conn pool]
- (let [cfg (assoc cfg :conn conn)]
- (handle-deletion cfg props)))))
-
-(s/def ::type ::us/keyword)
-(s/def ::id ::us/uuid)
-(s/def ::props (s/keys :req-un [::id ::type]))
-
-(defmulti handle-deletion
- (fn [_ props] (:type props)))
-
-(defmethod handle-deletion :default
- [_cfg {:keys [type]}]
- (l/warn :hint "no handler found"
- :type (d/name type)))
-
-(defmethod handle-deletion :file
- [{:keys [conn]} {:keys [id] :as props}]
- (let [sql "delete from file where id=? and deleted_at is not null"]
- (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :project
- [{:keys [conn]} {:keys [id] :as props}]
- (let [sql "delete from project where id=? and deleted_at is not null"]
- (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :team
- [{:keys [conn]} {:keys [id] :as props}]
- (let [sql "delete from team where id=? and deleted_at is not null"]
- (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :team-font-variant
- [{:keys [conn storage]} {:keys [id] :as props}]
- (let [font (db/get-by-id conn :team-font-variant id {:check-not-found false})
- storage (assoc storage :conn conn)]
- (when (:deleted-at font)
- (db/delete! conn :team-font-variant {:id id})
- (some->> (:woff1-file-id font) (sto/del-object storage))
- (some->> (:woff2-file-id font) (sto/del-object storage))
- (some->> (:otf-file-id font) (sto/del-object storage))
- (some->> (:ttf-file-id font) (sto/del-object storage)))))
diff --git a/backend/src/app/tasks/delete_profile.clj b/backend/src/app/tasks/delete_profile.clj
deleted file mode 100644
index 67a1733df..000000000
--- a/backend/src/app/tasks/delete_profile.clj
+++ /dev/null
@@ -1,79 +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) UXBOX Labs SL
-
-(ns app.tasks.delete-profile
- "Task for permanent deletion of profiles."
- (:require
- [app.common.spec :as us]
- [app.db :as db]
- [app.db.sql :as sql]
- [app.util.logging :as l]
- [clojure.spec.alpha :as s]
- [integrant.core :as ig]))
-
-;; TODO: DEPRECATED
-;; Should be removed in the 1.8.x
-
-(declare delete-profile-data)
-
-;; --- INIT
-
-(defmethod ig/pre-init-spec ::handler [_]
- (s/keys :req-un [::db/pool]))
-
-;; This task is responsible to permanently delete a profile with all
-;; the dependent data. As step (1) we delete all owned teams of the
-;; profile (that will cause to delete all underlying projects, files,
-;; file_media and mark to be deleted storage_object's used by team,
-;; profile and files previously deleted. Then, finally as step (2) we
-;; proceed to delete the profile row.
-;;
-;; The storage_objects marked as deleted will be deleted by the
-;; corresponding garbage collector task.
-
-(s/def ::profile-id ::us/uuid)
-(s/def ::props (s/keys :req-un [::profile-id]))
-
-(defmethod ig/init-key ::handler
- [_ {:keys [pool] :as cfg}]
- (fn [{:keys [props] :as task}]
- (us/verify ::props props)
- (db/with-atomic [conn pool]
- (let [id (:profile-id props)
- profile (db/exec-one! conn (sql/select :profile {:id id} {:for-update true}))]
- (if (or (:is-demo profile)
- (:deleted-at profile))
- (delete-profile-data conn id)
- (l/warn :hint "profile does not match constraints for deletion"
- :profile-id id))))))
-
-;; --- IMPL
-
-(def ^:private sql:remove-owned-teams
- "delete from team
- where id in (
- select tpr.team_id
- from team_profile_rel as tpr
- where tpr.is_owner is true
- and tpr.profile_id = ?
- )")
-
-(defn- delete-teams
- [conn profile-id]
- (db/exec-one! conn [sql:remove-owned-teams profile-id]))
-
-(defn delete-profile
- [conn profile-id]
- (db/delete! conn :profile {:id profile-id}))
-
-(defn- delete-profile-data
- [conn profile-id]
- (l/debug :action "delete profile"
- :profile-id profile-id)
- (delete-teams conn profile-id)
- (delete-profile conn profile-id)
- true)
-
diff --git a/backend/src/app/tasks/file_media_gc.clj b/backend/src/app/tasks/file_media_gc.clj
index aedcbc78b..2b8a13384 100644
--- a/backend/src/app/tasks/file_media_gc.clj
+++ b/backend/src/app/tasks/file_media_gc.clj
@@ -9,10 +9,10 @@
objects from files. A file is ellegible to be garbage collected
after some period of inactivity (the default threshold is 72h)."
(:require
+ [app.common.logging :as l]
[app.common.pages.migrations :as pmg]
[app.db :as db]
[app.util.blob :as blob]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
diff --git a/backend/src/app/tasks/file_offload.clj b/backend/src/app/tasks/file_offload.clj
index ee784d02d..a43afb8a9 100644
--- a/backend/src/app/tasks/file_offload.clj
+++ b/backend/src/app/tasks/file_offload.clj
@@ -7,11 +7,11 @@
(ns app.tasks.file-offload
"A maintenance task that offloads file data to an external storage (S3)."
(:require
+ [app.common.logging :as l]
[app.common.spec :as us]
[app.db :as db]
[app.storage :as sto]
[app.storage.impl :as simpl]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
diff --git a/backend/src/app/tasks/file_xlog_gc.clj b/backend/src/app/tasks/file_xlog_gc.clj
index 3037a7d5b..b8dce2fa5 100644
--- a/backend/src/app/tasks/file_xlog_gc.clj
+++ b/backend/src/app/tasks/file_xlog_gc.clj
@@ -8,8 +8,8 @@
"A maintenance task that performs a garbage collection of the file
change (transaction) log."
(:require
+ [app.common.logging :as l]
[app.db :as db]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
diff --git a/backend/src/app/tasks/objects_gc.clj b/backend/src/app/tasks/objects_gc.clj
index 112524560..a3d06dcdd 100644
--- a/backend/src/app/tasks/objects_gc.clj
+++ b/backend/src/app/tasks/objects_gc.clj
@@ -8,11 +8,11 @@
"A maintenance task that performs a general purpose garbage collection
of deleted objects."
(:require
+ [app.common.logging :as l]
[app.config :as cf]
[app.db :as db]
[app.storage :as sto]
[app.storage.impl :as simpl]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
diff --git a/backend/src/app/tasks/tasks_gc.clj b/backend/src/app/tasks/tasks_gc.clj
index a3560f0e1..788e29269 100644
--- a/backend/src/app/tasks/tasks_gc.clj
+++ b/backend/src/app/tasks/tasks_gc.clj
@@ -8,8 +8,8 @@
"A maintenance task that performs a cleanup of already executed tasks
from the database table."
(:require
+ [app.common.logging :as l]
[app.db :as db]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
diff --git a/backend/src/app/util/logging.clj b/backend/src/app/util/logging.clj
deleted file mode 100644
index 9a08e66b3..000000000
--- a/backend/src/app/util/logging.clj
+++ /dev/null
@@ -1,110 +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) UXBOX Labs SL
-
-(ns app.util.logging
- (:require
- [clojure.pprint :refer [pprint]])
- (:import
- org.apache.logging.log4j.Level
- org.apache.logging.log4j.LogManager
- org.apache.logging.log4j.Logger
- org.apache.logging.log4j.ThreadContext
- org.apache.logging.log4j.message.MapMessage
- org.apache.logging.log4j.spi.LoggerContext))
-
-(defn build-map-message
- [m]
- (let [message (MapMessage. (count m))]
- (reduce-kv #(.with ^MapMessage %1 (name %2) %3) message m)))
-
-(defprotocol ILogger
- (-enabled? [logger level])
- (-write! [logger level throwable message]))
-
-(def logger-context
- (LogManager/getContext false))
-
-(def logging-agent
- (agent nil :error-mode :continue))
-
-(defn get-logger
- [lname]
- (.getLogger ^LoggerContext logger-context ^String lname))
-
-(defn get-level
- [level]
- (case level
- :trace Level/TRACE
- :debug Level/DEBUG
- :info Level/INFO
- :warn Level/WARN
- :error Level/ERROR
- :fatal Level/FATAL))
-
-(defn enabled?
- [logger level]
- (.isEnabled ^Logger logger ^Level level))
-
-(defn write-log!
- [logger level e msg]
- (if e
- (.log ^Logger logger
- ^Level level
- ^Object msg
- ^Throwable e)
- (.log ^Logger logger
- ^Level level
- ^Object msg)))
-
-(defmacro log
- [& {:keys [level cause ::logger ::async ::raw] :as props}]
- (let [props (dissoc props :level :cause ::logger ::async ::raw)
- logger (or logger (str *ns*))
- logger-sym (gensym "log")
- level-sym (gensym "log")]
- `(let [~logger-sym (get-logger ~logger)
- ~level-sym (get-level ~level)]
- (if (enabled? ~logger-sym ~level-sym)
- ~(if async
- `(send-off logging-agent
- (fn [_#]
- (let [message# (or ~raw (build-map-message ~props))]
- (write-log! ~logger-sym ~level-sym ~cause message#))))
- `(let [message# (or ~raw (build-map-message ~props))]
- (write-log! ~logger-sym ~level-sym ~cause message#)))))))
-
-(defmacro info
- [& params]
- `(log :level :info ~@params))
-
-(defmacro error
- [& params]
- `(log :level :error ~@params))
-
-(defmacro warn
- [& params]
- `(log :level :warn ~@params))
-
-(defmacro debug
- [& params]
- `(log :level :debug ~@params))
-
-(defmacro trace
- [& params]
- `(log :level :trace ~@params))
-
-(defn update-thread-context!
- [data]
- (run! (fn [[key val]]
- (ThreadContext/put
- (name key)
- (cond
- (coll? val)
- (binding [clojure.pprint/*print-right-margin* 120]
- (with-out-str (pprint val)))
- (instance? clojure.lang.Named val) (name val)
- :else (str val))))
- data))
diff --git a/backend/src/app/util/migrations.clj b/backend/src/app/util/migrations.clj
index f79c50b2b..7b7fb8a44 100644
--- a/backend/src/app/util/migrations.clj
+++ b/backend/src/app/util/migrations.clj
@@ -6,7 +6,7 @@
(ns app.util.migrations
(:require
- [app.util.logging :as l]
+ [app.common.logging :as l]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[next.jdbc :as jdbc]))
diff --git a/backend/src/app/util/services.clj b/backend/src/app/util/services.clj
index 1621ad760..9faa8adcb 100644
--- a/backend/src/app/util/services.clj
+++ b/backend/src/app/util/services.clj
@@ -7,21 +7,34 @@
(ns app.util.services
"A helpers and macros for define rpc like registry based services."
(:refer-clojure :exclude [defmethod])
- (:require [app.common.data :as d]))
+ (:require
+ [app.common.data :as d]
+ [cuerdas.core :as str]))
(defmacro defmethod
[sname & body]
- (let [[mdata args body] (if (map? (first body))
- [(first body) (first (rest body)) (drop 2 body)]
- [nil (first body) (rest body)])
- mdata (assoc mdata
- ::spec sname
- ::name (name sname))
+ (let [[docs body] (if (string? (first body))
+ [(first body) (rest body)]
+ [nil body])
+ [mdata body] (if (map? (first body))
+ [(first body) (rest body)]
+ [nil body])
- sym (symbol (str "sm$" (name sname)))]
- `(do
- (def ~sym (fn ~args ~@body))
- (reset-meta! (var ~sym) ~mdata))))
+ [args body] (if (vector? (first body))
+ [(first body) (rest body)]
+ [nil body])]
+ (when-not args
+ (throw (IllegalArgumentException. "Missing arguments on `defmethod` macro.")))
+
+ (let [mdata (assoc mdata
+ ::docs (some-> docs str/<<-)
+ ::spec sname
+ ::name (name sname))
+
+ sym (symbol (str "sm$" (name sname)))]
+ `(do
+ (def ~sym (fn ~args ~@body))
+ (reset-meta! (var ~sym) ~mdata)))))
(def nsym-xf
(comp
diff --git a/backend/src/app/rpc/queries/svg.clj b/backend/src/app/util/svg.clj
similarity index 79%
rename from backend/src/app/rpc/queries/svg.clj
rename to backend/src/app/util/svg.clj
index 63c0b8aeb..9c3aab795 100644
--- a/backend/src/app/rpc/queries/svg.clj
+++ b/backend/src/app/util/svg.clj
@@ -4,13 +4,10 @@
;;
;; Copyright (c) UXBOX Labs SL
-(ns app.rpc.queries.svg
+(ns app.util.svg
(:require
[app.common.exceptions :as ex]
- [app.common.spec :as us]
- [app.util.logging :as l]
- [app.util.services :as sv]
- [clojure.spec.alpha :as s]
+ [app.common.logging :as l]
[clojure.xml :as xml]
[cuerdas.core :as str])
(:import
@@ -39,14 +36,6 @@
:hint "invalid svg file"
:cause e))))
-(declare pre-process)
-
-(s/def ::data ::us/string)
-(s/def ::parsed-svg (s/keys :req-un [::data]))
-
-(sv/defmethod ::parsed-svg
- [_ {:keys [data] :as params}]
- (->> data pre-process parse))
;; --- PROCESSORS
diff --git a/backend/src/app/worker.clj b/backend/src/app/worker.clj
index ed9d1982f..49370e164 100644
--- a/backend/src/app/worker.clj
+++ b/backend/src/app/worker.clj
@@ -9,12 +9,12 @@
(: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.db :as db]
[app.metrics :as mtx]
[app.util.async :as aa]
- [app.util.logging :as l]
[app.util.time :as dt]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
diff --git a/backend/test/app/services_files_test.clj b/backend/test/app/services_files_test.clj
index e22d8afc8..0fb5acc58 100644
--- a/backend/test/app/services_files_test.clj
+++ b/backend/test/app/services_files_test.clj
@@ -53,21 +53,6 @@
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result))))))
- (t/testing "query files (deprecated)"
- (let [data {::th/type :files
- :project-id proj-id
- :profile-id (:id prof)}
- out (th/query! data)]
-
- ;; (th/print-result! out)
- (t/is (nil? (:error out)))
-
- (let [result (:result out)]
- (t/is (= 1 (count result)))
- (t/is (= file-id (get-in result [0 :id])))
- (t/is (= "new name" (get-in result [0 :name])))
- (t/is (= 1 (count (get-in result [0 :data :pages])))))))
-
(t/testing "query files"
(let [data {::th/type :project-files
:project-id proj-id
@@ -120,7 +105,7 @@
(t/is (= (:type error-data) :not-found)))))
(t/testing "query list files after delete"
- (let [data {::th/type :files
+ (let [data {::th/type :project-files
:project-id proj-id
:profile-id (:id prof)}
out (th/query! data)]
diff --git a/backend/test/app/services_profile_test.clj b/backend/test/app/services_profile_test.clj
index d5e6dac43..b51bcd8c0 100644
--- a/backend/test/app/services_profile_test.clj
+++ b/backend/test/app/services_profile_test.clj
@@ -89,7 +89,7 @@
;; (th/print-result! out)
(t/is (nil? (:error out)))
- (t/is (nil? (:result out)))))
+ (t/is (map? (:result out)))))
(t/testing "query profile after update"
(let [data {::th/type :profile
@@ -136,7 +136,7 @@
(t/is (nil? (:error out))))
;; query files after profile soft deletion
- (let [params {::th/type :files
+ (let [params {::th/type :project-files
:project-id (:default-project-id prof)
:profile-id (:id prof)}
out (th/query! params)]
@@ -177,17 +177,6 @@
(t/is (string? token))
- ;; try register without accepting terms
- (let [data {::th/type :register-profile
- :token token
- :fullname "foobar"
- :accept-terms-and-privacy false}
- out (th/mutation! data)]
- (let [error (:error out)]
- (t/is (th/ex-info? error))
- (t/is (th/ex-of-type? error :validation))
- (t/is (th/ex-of-code? error :invalid-terms-and-privacy))))
-
;; try register without token
(let [data {::th/type :register-profile
:fullname "foobar"
@@ -205,16 +194,11 @@
:accept-terms-and-privacy true
:accept-newsletter-subscription true}]
(let [{:keys [result error]} (th/mutation! data)]
- (t/is (nil? error))
- (t/is (true? (get-in result [:props :accept-newsletter-subscription])))
- (t/is (true? (get-in result [:props :accept-terms-and-privacy])))))
+ (t/is (nil? error))))
))
(t/deftest prepare-register-with-registration-disabled
- (with-mocks [mock {:target 'app.config/get
- :return (th/mock-config-get-with
- {:registration-enabled false})}]
-
+ (th/with-mocks {#'app.config/flags nil}
(let [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "foobar"}]
diff --git a/backend/test/app/services_teams_test.clj b/backend/test/app/services_teams_test.clj
index 2831ea4ee..6dd7470da 100644
--- a/backend/test/app/services_teams_test.clj
+++ b/backend/test/app/services_teams_test.clj
@@ -33,11 +33,13 @@
:role :editor
:profile-id (:id profile1)}]
- ;; (th/print-result! out)
;; invite external user without complaints
(let [data (assoc data :email "foo@bar.com")
out (th/mutation! data)]
+
+ ;; (th/print-result! out)
+
(t/is (nil? (:result out)))
(t/is (= 1 (:call-count (deref mock)))))
@@ -111,6 +113,7 @@
:id (:id team)
:profile-id (:id profile1)}
out (th/mutation! params)]
+ ;; (th/print-result! out)
(t/is (nil? (:error out))))
;; query the list of teams after soft deletion
@@ -133,7 +136,6 @@
:profile-id (:id profile1)}
out (th/query! data)]
;; (th/print-result! out)
-
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 0 (count result)))))
diff --git a/backend/test/app/test_helpers.clj b/backend/test/app/test_helpers.clj
index ba8999123..43334b883 100644
--- a/backend/test/app/test_helpers.clj
+++ b/backend/test/app/test_helpers.clj
@@ -7,6 +7,7 @@
(ns app.test-helpers
(:require
[app.common.data :as d]
+ [app.common.flags :as flags]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
@@ -336,9 +337,15 @@
[data]
(fn
([key]
- (get data key (get @cf/config key)))
+ (get data key (get cf/config key)))
([key default]
- (get data key (get @cf/config key default)))))
+ (get data key (get cf/config key default)))))
+
+
+(defmacro with-mocks
+ [rebinds & body]
+ `(with-redefs-fn ~rebinds
+ (fn [] ~@body)))
(defn reset-mock!
[m]
diff --git a/common/src/app/common/data.cljc b/common/src/app/common/data.cljc
index 3d227cb38..77dcae010 100644
--- a/common/src/app/common/data.cljc
+++ b/common/src/app/common/data.cljc
@@ -69,6 +69,11 @@
(next colls))
(persistent! result))))
+(defn preconj
+ [coll elem]
+ (assert (vector? coll))
+ (concat [elem] coll))
+
(defn enumerate
([items] (enumerate items 0))
([items start]
@@ -154,6 +159,11 @@
([mfn coll]
(into {} (mapm mfn) coll)))
+(defn removev
+ "Returns a vector of the items in coll for which (fn item) returns logical false"
+ [fn coll]
+ (filterv (comp not fn) coll))
+
(defn filterm
"Filter values of a map that satisfy a predicate"
[pred coll]
diff --git a/common/src/app/common/exceptions.cljc b/common/src/app/common/exceptions.cljc
index 5818578a9..3371dbbd9 100644
--- a/common/src/app/common/exceptions.cljc
+++ b/common/src/app/common/exceptions.cljc
@@ -27,7 +27,10 @@
[& {:keys [message hint cause] :as params}]
(s/assert ::error-params params)
(let [message (or message hint "")
- payload (dissoc params :cause)]
+ payload (-> params
+ (dissoc :cause)
+ (dissoc :message)
+ (assoc :hint message))]
(ex-info message payload cause)))
(defmacro raise
diff --git a/common/src/app/common/file_builder.cljc b/common/src/app/common/file_builder.cljc
index 4a497cda5..0ae1127df 100644
--- a/common/src/app/common/file_builder.cljc
+++ b/common/src/app/common/file_builder.cljc
@@ -278,6 +278,48 @@
(-> file
(update :parent-stack pop))))
+(defn add-bool [file data]
+ (let [frame-id (:current-frame-id file)
+ name (:name data)
+ obj (-> {:id (uuid/next)
+ :type :bool
+ :name name
+ :shapes []
+ :frame-id frame-id}
+ (merge data)
+ (check-name file :bool)
+ (d/without-nils))]
+ (-> file
+ (commit-shape obj)
+ (assoc :last-id (:id obj))
+ (add-name (:name obj))
+ (update :parent-stack conjv (:id obj)))))
+
+(defn close-bool [file]
+ (let [bool-id (-> file :parent-stack peek)
+ bool (lookup-shape file bool-id)
+ children (->> bool :shapes (mapv #(lookup-shape file %)))
+
+ file
+ (let [objects (lookup-objects file)
+ bool' (gsh/update-bool-selrect bool children objects)]
+ (commit-change
+ file
+ {:type :mod-obj
+ :id bool-id
+ :operations
+ [{:type :set :attr :selrect :val (:selrect bool')}
+ {:type :set :attr :points :val (:points bool')}
+ {:type :set :attr :x :val (-> bool' :selrect :x)}
+ {:type :set :attr :y :val (-> bool' :selrect :y)}
+ {:type :set :attr :width :val (-> bool' :selrect :width)}
+ {:type :set :attr :height :val (-> bool' :selrect :height)}]}
+
+ {:add-container? true}))]
+
+ (-> file
+ (update :parent-stack pop))))
+
(defn create-shape [file type data]
(let [frame-id (:current-frame-id file)
frame (when-not (= frame-id root-frame)
@@ -332,21 +374,76 @@
(-> file
(update :parent-stack pop)))
+(defn- read-classifier
+ [interaction-src]
+ (select-keys interaction-src [:event-type :action-type]))
+
+(defmulti read-event-opts :event-type)
+
+(defmethod read-event-opts :after-delay
+ [interaction-src]
+ (select-keys interaction-src [:delay]))
+
+(defmethod read-event-opts :default
+ [_]
+ {})
+
+(defmulti read-action-opts :action-type)
+
+(defmethod read-action-opts :navigate
+ [interaction-src]
+ (select-keys interaction-src [:destination]))
+
+(defmethod read-action-opts :open-overlay
+ [interaction-src]
+ (select-keys interaction-src [:destination
+ :overlay-position
+ :overlay-pos-type
+ :close-click-outside
+ :background-overlay]))
+
+(defmethod read-action-opts :toggle-overlay
+ [interaction-src]
+ (select-keys interaction-src [:destination
+ :overlay-position
+ :overlay-pos-type
+ :close-click-outside
+ :background-overlay]))
+
+(defmethod read-action-opts :close-overlay
+ [interaction-src]
+ (select-keys interaction-src [:destination]))
+
+(defmethod read-action-opts :prev-screen
+ [_]
+ {})
+
+(defmethod read-action-opts :open-url
+ [interaction-src]
+ (select-keys interaction-src [:url]))
+
(defn add-interaction
- [file from-id {:keys [action-type event-type destination]}]
+ [file from-id interaction-src]
(assert (some? (lookup-shape file from-id)) (str "Cannot locate shape with id " from-id))
- (assert (some? (lookup-shape file destination)) (str "Cannot locate shape with id " destination))
- (let [interactions (->> (lookup-shape file from-id)
- :interactions
- (filterv #(or (not= (:action-type %) action-type)
- (not= (:event-type %) event-type))))
- interactions (-> interactions
+ (let [{:keys [event-type action-type]} (read-classifier interaction-src)
+ {:keys [delay]} (read-event-opts interaction-src)
+ {:keys [destination overlay-pos-type overlay-position url
+ close-click-outside background-overlay]} (read-action-opts interaction-src)
+
+ interactions (-> (lookup-shape file from-id)
+ :interactions
(conjv
- {:action-type action-type
- :event-type event-type
- :destination destination}))]
+ (d/without-nils {:event-type event-type
+ :action-type action-type
+ :delay delay
+ :destination destination
+ :overlay-pos-type overlay-pos-type
+ :overlay-position overlay-position
+ :url url
+ :close-click-outside close-click-outside
+ :background-overlay background-overlay})))]
(commit-change
file
{:type :mod-obj
diff --git a/common/src/app/common/flags.cljc b/common/src/app/common/flags.cljc
index a5a051f7c..acc1d2c5c 100644
--- a/common/src/app/common/flags.cljc
+++ b/common/src/app/common/flags.cljc
@@ -9,24 +9,31 @@
(:require
[cuerdas.core :as str]))
+(def default
+ #{:backend-asserts
+ :api-doc
+ :registration
+ :demo-users})
+
(defn parse
- [default flags]
- (loop [flags (seq flags)
- result default]
- (let [item (first flags)]
- (if (nil? item)
- result
- (let [sname (name item)]
- (cond
- (str/starts-with? sname "enable-")
- (recur (rest flags)
- (conj result (keyword (subs sname 7))))
+ ([flags] (parse flags #{}))
+ ([flags default]
+ (loop [flags (seq flags)
+ result default]
+ (let [item (first flags)]
+ (if (nil? item)
+ result
+ (let [sname (name item)]
+ (cond
+ (str/starts-with? sname "enable-")
+ (recur (rest flags)
+ (conj result (keyword (subs sname 7))))
- (str/starts-with? sname "disable-")
- (recur (rest flags)
- (disj result (keyword (subs sname 8))))
+ (str/starts-with? sname "disable-")
+ (recur (rest flags)
+ (disj result (keyword (subs sname 8))))
- :else
- (recur (rest flags) result)))))))
+ :else
+ (recur (rest flags) result))))))))
diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc
index 0d3feeb06..b73a050e6 100644
--- a/common/src/app/common/geom/point.cljc
+++ b/common/src/app/common/geom/point.cljc
@@ -22,7 +22,8 @@
(defn ^boolean point?
"Return true if `v` is Point instance."
[v]
- (instance? Point v))
+ (or (instance? Point v)
+ (and (map? v) (contains? v :x) (contains? v :y))))
(defn ^boolean point-like?
[{:keys [x y] :as v}]
@@ -257,15 +258,12 @@
(and (mth/almost-zero? x)
(mth/almost-zero? y)))
-(defn line-val
- "Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector
- generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return
- the point (0.25, 0.25)"
- [p1 p2 v]
- (let [v (-> (to-vec p1 p2)
- (scale v))]
- (add p1 v)))
-
+(defn lerp
+ "Calculates a linear interpolation between two points given a tvalue"
+ [p1 p2 t]
+ (let [x (mth/lerp (:x p1) (:x p2) t)
+ y (mth/lerp (:y p1) (:y p2) t)]
+ (point x y)))
(defn rotate
"Rotates the point around center with an angle"
diff --git a/common/src/app/common/geom/shapes.cljc b/common/src/app/common/geom/shapes.cljc
index 8771ff2e3..91a7043ba 100644
--- a/common/src/app/common/geom/shapes.cljc
+++ b/common/src/app/common/geom/shapes.cljc
@@ -8,11 +8,13 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
+ [app.common.geom.shapes.bool :as gsb]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.intersect :as gin]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
- [app.common.geom.shapes.transforms :as gtr]))
+ [app.common.geom.shapes.transforms :as gtr]
+ [app.common.math :as mth]))
;; --- Setup (Initialize)
;; FIXME: Is this the correct place for these functions?
@@ -126,6 +128,13 @@
(assoc :selrect selrect
:points points))))
+(defn shape-stroke-margin
+ [shape stroke-width]
+ (if (= (:type shape) :path)
+ ;; TODO: Calculate with the stroke offset (not implemented yet
+ (mth/sqrt (* 2 stroke-width stroke-width))
+ (- (mth/sqrt (* 2 stroke-width stroke-width)) stroke-width)))
+
;; EXPORTS
(d/export gco/center-shape)
@@ -133,19 +142,20 @@
(d/export gco/center-rect)
(d/export gco/center-points)
(d/export gco/make-centered-rect)
+(d/export gco/transform-points)
(d/export gpr/rect->selrect)
(d/export gpr/rect->points)
(d/export gpr/points->selrect)
(d/export gpr/points->rect)
(d/export gpr/center->rect)
+(d/export gpr/join-rects)
(d/export gtr/move)
(d/export gtr/absolute-move)
(d/export gtr/transform-matrix)
(d/export gtr/inverse-transform-matrix)
(d/export gtr/transform-point-center)
-(d/export gtr/transform-points)
(d/export gtr/transform-rect)
(d/export gtr/calculate-adjust-matrix)
(d/export gtr/update-group-selrect)
@@ -156,12 +166,15 @@
(d/export gtr/calc-child-modifiers)
;; PATHS
-(d/export gsp/content->points)
(d/export gsp/content->selrect)
(d/export gsp/transform-content)
+(d/export gsp/open-path?)
;; Intersection
(d/export gin/overlaps?)
(d/export gin/has-point?)
(d/export gin/has-point-rect?)
(d/export gin/rect-contains-shape?)
+
+;; Bool
+(d/export gsb/update-bool-selrect)
diff --git a/common/src/app/common/geom/shapes/bool.cljc b/common/src/app/common/geom/shapes/bool.cljc
new file mode 100644
index 000000000..93b7ccc72
--- /dev/null
+++ b/common/src/app/common/geom/shapes/bool.cljc
@@ -0,0 +1,32 @@
+;; 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.common.geom.shapes.bool
+ (:require
+ [app.common.geom.shapes.path :as gsp]
+ [app.common.geom.shapes.rect :as gpr]
+ [app.common.geom.shapes.transforms :as gtr]
+ [app.common.path.bool :as pb]
+ [app.common.path.shapes-to-path :as stp]))
+
+(defn update-bool-selrect
+ "Calculates the selrect+points for the boolean shape"
+ [shape children objects]
+
+ (let [content (->> children
+ (map #(stp/convert-to-path % objects))
+ (mapv :content)
+ (pb/content-bool (:bool-type shape)))
+
+ [points selrect]
+ (if (empty? content)
+ (let [selrect (gtr/selection-rect children)
+ points (gpr/rect->points selrect)]
+ [points selrect])
+ (gsp/content->points+selrect shape content))]
+ (-> shape
+ (assoc :selrect selrect)
+ (assoc :points points))))
diff --git a/common/src/app/common/geom/shapes/common.cljc b/common/src/app/common/geom/shapes/common.cljc
index 9b5c6d1b3..00eec4386 100644
--- a/common/src/app/common/geom/shapes/common.cljc
+++ b/common/src/app/common/geom/shapes/common.cljc
@@ -6,6 +6,7 @@
(ns app.common.geom.shapes.common
(:require
+ [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.math :as mth]))
@@ -48,3 +49,14 @@
:y (- (:y center) (/ height 2.0))
:width width
:height height})
+
+(defn transform-points
+ ([points matrix]
+ (transform-points points nil matrix))
+ ([points center matrix]
+ (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
+ post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
+
+ tr-point (fn [point]
+ (gpt/transform point (gmt/multiply prev matrix post)))]
+ (mapv tr-point points))))
diff --git a/common/src/app/common/geom/shapes/intersect.cljc b/common/src/app/common/geom/shapes/intersect.cljc
index 4b0593dc1..3cc358965 100644
--- a/common/src/app/common/geom/shapes/intersect.cljc
+++ b/common/src/app/common/geom/shapes/intersect.cljc
@@ -284,12 +284,19 @@
(defn overlaps?
"General case to check for overlaping between shapes and a rectangle"
[shape rect]
- (or (not shape)
- (let [path? (= :path (:type shape))
- circle? (= :circle (:type shape))]
- (and (overlaps-rect-points? rect (:points shape))
- (or (not path?) (overlaps-path? shape rect))
- (or (not circle?) (overlaps-ellipse? shape rect))))))
+ (let [stroke-width (/ (or (:stroke-width shape) 0) 2)
+ rect (-> rect
+ (update :x - stroke-width)
+ (update :y - stroke-width)
+ (update :width + (* 2 stroke-width))
+ (update :height + (* 2 stroke-width))
+ )]
+ (or (not shape)
+ (let [path? (= :path (:type shape))
+ circle? (= :circle (:type shape))]
+ (and (overlaps-rect-points? rect (:points shape))
+ (or (not path?) (overlaps-path? shape rect))
+ (or (not circle?) (overlaps-ellipse? shape rect)))))))
(defn has-point-rect?
[rect point]
@@ -308,3 +315,4 @@
(->> shape
:points
(every? (partial has-point-rect? rect))))
+
diff --git a/common/src/app/common/geom/shapes/path.cljc b/common/src/app/common/geom/shapes/path.cljc
index ff39fa7db..d8bd67cfc 100644
--- a/common/src/app/common/geom/shapes/path.cljc
+++ b/common/src/app/common/geom/shapes/path.cljc
@@ -7,97 +7,276 @@
(ns app.common.geom.shapes.path
(:require
[app.common.data :as d]
+ [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
+ [app.common.geom.shapes.common :as gsc]
[app.common.geom.shapes.rect :as gpr]
- [app.common.math :as mth]))
+ [app.common.math :as mth]
+ [app.common.path.commands :as upc]
+ [app.common.path.subpaths :as sp]))
-(defn content->points [content]
+(def ^:const curve-curve-precision 0.1)
+(def ^:const curve-range-precision 2)
+
+(defn s= [a b]
+ (mth/almost-zero? (- a b)))
+
+(defn calculate-opposite-handler
+ "Given a point and its handler, gives the symetric handler"
+ [point handler]
+ (let [handler-vector (gpt/to-vec point handler)]
+ (gpt/add point (gpt/negate handler-vector))))
+
+(defn opposite-handler
+ "Calculates the coordinates of the opposite handler"
+ [point handler]
+ (let [phv (gpt/to-vec point handler)]
+ (gpt/add point (gpt/negate phv))))
+
+(defn opposite-handler-keep-distance
+ "Calculates the coordinates of the opposite handler but keeping the old distance"
+ [point handler old-opposite]
+ (let [old-distance (gpt/distance point old-opposite)
+ phv (gpt/to-vec point handler)
+ phv2 (gpt/multiply
+ (gpt/unit (gpt/negate phv))
+ (gpt/point old-distance))]
+ (gpt/add point phv2)))
+
+(defn content->points
+ "Returns the points in the given content"
+ [content]
(->> content
- (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
+ (map #(when (-> % :params :x)
+ (gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))
+(defn line-values
+ [[from-p to-p] t]
+ (let [move-v (-> (gpt/to-vec from-p to-p)
+ (gpt/scale t))]
+ (gpt/add from-p move-v)))
+
+(defn line-windup
+ [[from-p to-p :as l] t]
+ (let [p (line-values l t)
+ cy (:y p)
+ ay (:y to-p)
+ by (:y from-p)]
+ (cond
+ (and (> (- cy ay) 0) (not (s= cy ay))) 1
+ (and (< (- cy ay) 0) (not (s= cy ay))) -1
+ (< (- cy by) 0) 1
+ (> (- cy by) 0) -1
+ :else 0)))
+
;; https://medium.com/@Acegikmo/the-ever-so-lovely-b%C3%A9zier-curve-eb27514da3bf
;; https://en.wikipedia.org/wiki/Bernstein_polynomial
(defn curve-values
"Parametric equation for cubic beziers. Given a start and end and
two intermediate points returns points for values of t.
If you draw t on a plane you got the bezier cube"
- [start end h1 h2 t]
+ ([[start end h1 h2] t]
+ (curve-values start end h1 h2 t))
- (let [t2 (* t t) ;; t square
- t3 (* t2 t) ;; t cube
+ ([start end h1 h2 t]
+ (let [t2 (* t t) ;; t square
+ t3 (* t2 t) ;; t cube
- start-v (+ (- t3) (* 3 t2) (* -3 t) 1)
- h1-v (+ (* 3 t3) (* -6 t2) (* 3 t))
- h2-v (+ (* -3 t3) (* 3 t2))
- end-v t3
+ start-v (+ (- t3) (* 3 t2) (* -3 t) 1)
+ h1-v (+ (* 3 t3) (* -6 t2) (* 3 t))
+ h2-v (+ (* -3 t3) (* 3 t2))
+ end-v t3
- coord-v (fn [coord]
- (+ (* (coord start) start-v)
- (* (coord h1) h1-v)
- (* (coord h2) h2-v)
- (* (coord end) end-v)))]
+ coord-v (fn [coord]
+ (+ (* (coord start) start-v)
+ (* (coord h1) h1-v)
+ (* (coord h2) h2-v)
+ (* (coord end) end-v)))]
- (gpt/point (coord-v :x) (coord-v :y))))
+ (gpt/point (coord-v :x) (coord-v :y)))))
+
+(defn curve-tangent
+ "Retrieve the tangent vector to the curve in the point `t`"
+ [[start end h1 h2] t]
+
+ (let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
+ [(:y start) (:y h1) (:y h2) (:y end)]]
+
+ solve-derivative
+ (fn [[c0 c1 c2 c3]]
+ ;; Solve B'(t) given t to retrieve the value for the
+ ;; first derivative
+ (let [t2 (* t t)]
+ (+ (* c0 (+ (* -3 t2) (* 6 t) -3))
+ (* c1 (+ (* 9 t2) (* -12 t) 3))
+ (* c2 (+ (* -9 t2) (* 6 t)))
+ (* c3 (* 3 t2)))))
+
+ [x y] (->> coords (mapv solve-derivative))
+
+ ;; normalize value
+ d (mth/sqrt (+ (* x x) (* y y)))]
+
+ (gpt/point (/ x d) (/ y d))))
+
+(defn curve-windup
+ [curve t]
+
+ (let [tangent (curve-tangent curve t)]
+ (cond
+ (> (:y tangent) 0) -1
+ (< (:y tangent) 0) 1
+ :else 0)))
(defn curve-split
"Splits a curve into two at the given parametric value `t`.
Calculates the Casteljau's algorithm intermediate points"
- [start end h1 h2 t]
+ ([[start end h1 h2] t]
+ (curve-split start end h1 h2 t))
- (let [p1 (gpt/line-val start h1 t)
- p2 (gpt/line-val h1 h2 t)
- p3 (gpt/line-val h2 end t)
- p4 (gpt/line-val p1 p2 t)
- p5 (gpt/line-val p2 p3 t)
- sp (gpt/line-val p4 p5 t)]
- [[start sp p1 p4]
- [sp end p5 p3]]))
+ ([start end h1 h2 t]
+ (let [p1 (gpt/lerp start h1 t)
+ p2 (gpt/lerp h1 h2 t)
+ p3 (gpt/lerp h2 end t)
+ p4 (gpt/lerp p1 p2 t)
+ p5 (gpt/lerp p2 p3 t)
+ sp (gpt/lerp p4 p5 t)]
+ [[start sp p1 p4]
+ [sp end p5 p3]])))
+
+(defn subcurve-range
+ "Given a curve returns a new curve between the values t1-t2"
+ ([[start end h1 h2] [t1 t2]]
+ (subcurve-range start end h1 h2 t1 t2))
+
+ ([[start end h1 h2] t1 t2]
+ (subcurve-range start end h1 h2 t1 t2))
+
+ ([start end h1 h2 t1 t2]
+ ;; Make sure that t2 is greater than t1
+ (let [[t1 t2] (if (< t1 t2) [t1 t2] [t2 t1])
+ t2' (/ (- t2 t1) (- 1 t1))
+ [_ curve'] (curve-split start end h1 h2 t1)]
+ (first (curve-split curve' t2')))))
+
+
+;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm
+(defn- solve-roots
+ "Solvers a quadratic or cubic equation given by the parameters a b c d"
+ ([a b c]
+ (solve-roots a b c 0))
+
+ ([a b c d]
+ (let [sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
+ (cond
+ ;; No solutions
+ (and (mth/almost-zero? d) (mth/almost-zero? a) (mth/almost-zero? b))
+ []
+
+ ;; Linear solution
+ (and (mth/almost-zero? d) (mth/almost-zero? a))
+ [(/ (- c) b)]
+
+ ;; Cuadratic
+ (mth/almost-zero? d)
+ [(/ (+ (- b) sqrt-b2-4ac)
+ (* 2 a))
+ (/ (- (- b) sqrt-b2-4ac)
+ (* 2 a))]
+
+ ;; Cubic
+ :else
+ (let [a (/ a d)
+ b (/ b d)
+ c (/ c d)
+
+ p (/ (- (* 3 b) (* a a)) 3)
+ q (/ (+ (* 2 a a a) (* -9 a b) (* 27 c)) 27)
+
+ p3 (/ p 3)
+ q2 (/ q 2)
+ discriminant (+ (* q2 q2) (* p3 p3 p3))]
+
+ (cond
+ (< discriminant 0)
+ (let [mp3 (/ (- p) 3)
+ mp33 (* mp3 mp3 mp3)
+ r (mth/sqrt mp33)
+ t (/ (- q) (* 2 r))
+ cosphi (cond (< t -1) -1
+ (> t 1) 1
+ :else t)
+ phi (mth/acos cosphi)
+ crtr (mth/cubicroot r)
+ t1 (* 2 crtr)
+ root1 (- (* t1 (mth/cos (/ phi 3))) (/ a 3))
+ root2 (- (* t1 (mth/cos (/ (+ phi (* 2 mth/PI)) 3))) (/ a 3))
+ root3 (- (* t1 (mth/cos (/ (+ phi (* 4 mth/PI)) 3))) (/ a 3))]
+
+ [root1 root2 root3])
+
+ (mth/almost-zero? discriminant)
+ (let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2)))
+ root1 (- (* 2 u1) (/ a 3))
+ root2 (- (- u1) (/ a 3))]
+ [root1 root2])
+
+ :else
+ (let [sd (mth/sqrt discriminant)
+ u1 (mth/cubicroot (- sd q2))
+ v1 (mth/cubicroot (+ sd q2))
+ root (- u1 v1 (/ a 3))]
+ [root])))))))
;; https://pomax.github.io/bezierinfo/#extremities
(defn curve-extremities
- "Given a cubic bezier cube finds its roots in t. This are the extremities
- if we calculate its values for x, y we can find a bounding box for the curve."
- [start end h1 h2]
+ "Calculates the extremities by solving the first derivative for a cubic
+ bezier and then solving the quadratic formula"
+ ([[start end h1 h2]]
+ (curve-extremities start end h1 h2))
- (let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
- [(:y start) (:y h1) (:y h2) (:y end)]]
+ ([start end h1 h2]
- coord->tvalue
- (fn [[c0 c1 c2 c3]]
+ (let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
+ [(:y start) (:y h1) (:y h2) (:y end)]]
- (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
- b (+ (* 6 c0) (* -12 c1) (* 6 c2))
- c (+ (* 3 c1) (* -3 c0))
+ coord->tvalue
+ (fn [[c0 c1 c2 c3]]
+ (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
+ b (+ (* 6 c0) (* -12 c1) (* 6 c2))
+ c (+ (* 3 c1) (* -3 c0))]
- sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
+ (solve-roots a b c)))]
+ (->> coords
+ (mapcat coord->tvalue)
- (cond
- (and (mth/almost-zero? a)
- (not (mth/almost-zero? b)))
- ;; When the term a is close to zero we have a linear equation
- [(/ (- c) b)]
+ ;; Only values in the range [0, 1] are valid
+ (filterv #(and (> % 0.01) (< % 0.99)))))))
- ;; If a is not close to zero return the two roots for a cuadratic
- (not (mth/almost-zero? a))
- [(/ (+ (- b) sqrt-b2-4ac)
- (* 2 a))
- (/ (- (- b) sqrt-b2-4ac)
- (* 2 a))]
+(defn curve-roots
+ "Uses cardano algorithm to find the roots for a cubic bezier"
+ ([[start end h1 h2] coord]
+ (curve-roots start end h1 h2 coord))
- ;; If a and b close to zero we can't find a root for a constant term
- :else
- [])))]
- (->> coords
- (mapcat coord->tvalue)
+ ([start end h1 h2 coord]
- ;; Only values in the range [0, 1] are valid
- (filter #(and (>= % 0) (<= % 1)))
+ (let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]]
- ;; Pass t-values to actual points
- (map #(curve-values start end h1 h2 %)))
- ))
+ coord->tvalue
+ (fn [[pa pb pc pd]]
+
+ (let [a (+ (* 3 pa) (* -6 pb) (* 3 pc))
+ b (+ (* -3 pa) (* 3 pb))
+ c pa
+ d (+ (- pa) (* 3 pb) (* -3 pc) pd)]
+
+ (solve-roots a b c d)))]
+ (->> coords
+ (mapcat coord->tvalue)
+ ;; Only values in the range [0, 1] are valid
+ (filterv #(and (>= % 0) (<= % 1)))))))
(defn command->point
([command] (command->point command nil))
@@ -107,7 +286,50 @@
ykey (keyword (str prefix "y"))
x (get params xkey)
y (get params ykey)]
- (gpt/point x y))))
+ (when (and (some? x) (some? y))
+ (gpt/point x y)))))
+
+(defn command->line
+ ([cmd]
+ (command->line cmd (:prev cmd)))
+ ([cmd prev]
+ [prev (command->point cmd)]))
+
+(defn command->bezier
+ ([cmd]
+ (command->bezier cmd (:prev cmd)))
+ ([cmd prev]
+ [prev
+ (command->point cmd)
+ (gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y))
+ (gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))]))
+
+(defn command->selrect
+ ([command]
+ (command->selrect command (:prev command)))
+
+ ([command prev-point]
+ (let [points (case (:command command)
+ :move-to [(command->point command)]
+
+ ;; If it's a line we add the beginning point and endpoint
+ :line-to [prev-point (command->point command)]
+
+ ;; We return the bezier extremities
+ :curve-to (d/concat
+ [prev-point
+ (command->point command)]
+ (let [curve [prev-point
+ (command->point command)
+ (command->point command :c1)
+ (command->point command :c2)]]
+ (->> (curve-extremities curve)
+ (mapv #(curve-values curve %)))))
+ [])
+ selrect (gpr/points->selrect points)]
+ (-> selrect
+ (update :width #(if (mth/almost-zero? %) 1 %))
+ (update :height #(if (mth/almost-zero? %) 1 %))))))
(defn content->selrect [content]
(let [calc-extremities
@@ -123,10 +345,12 @@
:curve-to (d/concat
[(command->point prev)
(command->point command)]
- (curve-extremities (command->point prev)
- (command->point command)
- (command->point command :c1)
- (command->point command :c2)))
+ (let [curve [(command->point prev)
+ (command->point command)
+ (command->point command :c1)
+ (command->point command :c2)]]
+ (->> (curve-extremities curve)
+ (mapv #(curve-values curve %)))))
[]))
extremities (mapcat calc-extremities
@@ -154,7 +378,11 @@
(not (nil? c1x)) (set-tr :c1x :c1y)
(not (nil? c2x)) (set-tr :c2x :c2y)))]
- (mapv #(update % :params transform-params) content)))
+ (->> content
+ (mapv (fn [cmd]
+ (cond-> cmd
+ (map? cmd)
+ (update :params transform-params)))))))
(defn transform-content
[content transform]
@@ -302,24 +530,25 @@
"Given a path and a position"
[shape position]
- (let [point+distance (fn [[cur-cmd prev-cmd]]
- (let [from-p (command->point prev-cmd)
- to-p (command->point cur-cmd)
- h1 (gpt/point (get-in cur-cmd [:params :c1x])
- (get-in cur-cmd [:params :c1y]))
- h2 (gpt/point (get-in cur-cmd [:params :c2x])
- (get-in cur-cmd [:params :c2y]))
- point
- (case (:command cur-cmd)
- :line-to
- (line-closest-point position from-p to-p)
+ (let [point+distance
+ (fn [[cur-cmd prev-cmd]]
+ (let [from-p (command->point prev-cmd)
+ to-p (command->point cur-cmd)
+ h1 (gpt/point (get-in cur-cmd [:params :c1x])
+ (get-in cur-cmd [:params :c1y]))
+ h2 (gpt/point (get-in cur-cmd [:params :c2x])
+ (get-in cur-cmd [:params :c2y]))
+ point
+ (case (:command cur-cmd)
+ :line-to
+ (line-closest-point position from-p to-p)
- :curve-to
- (curve-closest-point position from-p to-p h1 h2)
+ :curve-to
+ (curve-closest-point position from-p to-p h1 h2)
- nil)]
- (when point
- [point (gpt/distance point position)])))
+ nil)]
+ (when point
+ [point (gpt/distance point position)])))
find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
@@ -331,3 +560,399 @@
(map point+distance)
(reduce find-min-point)
(first))))
+
+(defn- get-line-tval
+ [[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [x y]}]
+ (cond
+ (and (s= x1 x2) (s= y1 y2))
+ ##Inf
+
+ (s= x1 x2)
+ (/ (- y y1) (- y2 y1))
+
+ :else
+ (/ (- x x1) (- x2 x1))))
+
+(defn- curve-range->rect
+ [curve from-t to-t]
+
+ (let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
+ extremes (->> (curve-extremities curve)
+ (mapv #(curve-values curve %)))]
+ (gpr/points->rect (into [from-p to-p] extremes))))
+
+(defn line-has-point?
+ "Using the line equation we put the x value and check if matches with
+ the given Y. If it does the point is inside the line"
+ [point [from-p to-p]]
+ (let [{x1 :x y1 :y} from-p
+ {x2 :x y2 :y} to-p
+ {px :x py :y} point
+
+ m (when-not (s= x1 x2) (/ (- y2 y1) (- x2 x1)))
+ vy (when (some? m) (+ (* m px) (* (- m) x1) y1))]
+
+ ;; If x1 = x2 there is no slope, to see if the point is in the line
+ ;; only needs to check the x is the same
+ (or (and (s= x1 x2) (s= px x1))
+ (and (some? vy) (s= py vy)))))
+
+(defn segment-has-point?
+ "Using the line equation we put the x value and check if matches with
+ the given Y. If it does the point is inside the line"
+ [point line]
+
+ (and (line-has-point? point line)
+ (let [t (get-line-tval line point)]
+ (and (or (> t 0) (s= t 0))
+ (or (< t 1) (s= t 1))))))
+
+(defn curve-has-point?
+ [point curve]
+ (letfn [(check-range [from-t to-t]
+ (let [r (curve-range->rect curve from-t to-t)]
+ (when (gpr/contains-point? r point)
+ (if (s= from-t to-t)
+ (< (gpt/distance (curve-values curve from-t) point) 0.1)
+
+ (let [half-t (+ from-t (/ (- to-t from-t) 2.0))]
+ (or (check-range from-t half-t)
+ (check-range half-t to-t)))))))]
+
+ (check-range 0 1)))
+
+(defn line-line-crossing
+ [[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]]
+
+ (let [{x1 :x y1 :y} from-p1
+ {x2 :x y2 :y} to-p1
+
+ {x3 :x y3 :y} from-p2
+ {x4 :x y4 :y} to-p2
+
+ nx (- (* (- x3 x4) (- (* x1 y2) (* y1 x2)))
+ (* (- x1 x2) (- (* x3 y4) (* y3 x4))))
+
+ ny (- (* (- y3 y4) (- (* x1 y2) (* y1 x2)))
+ (* (- y1 y2) (- (* x3 y4) (* y3 x4))))
+
+ d (- (* (- x1 x2) (- y3 y4))
+ (* (- y1 y2) (- x3 x4)))]
+
+ (cond
+ (not (mth/almost-zero? d))
+ ;; Coordinates in the line. We calculate the tvalue that will
+ ;; return 0-1 as a percentage in the segment
+ (let [cross-p (gpt/point (/ nx d) (/ ny d))
+ t1 (get-line-tval l1 cross-p)
+ t2 (get-line-tval l2 cross-p)]
+ [t1 t2])
+
+ ;; If they are parallels they could define the same line
+ (line-has-point? from-p2 l1) [(get-line-tval l1 from-p2) 0]
+ (line-has-point? to-p2 l1) [(get-line-tval l1 to-p2) 1]
+ (line-has-point? to-p1 l2) [1 (get-line-tval l2 to-p1)]
+ (line-has-point? from-p1 l2) [0 (get-line-tval l2 from-p1)]
+
+ :else
+ nil)))
+
+(defn line-curve-crossing
+ [[from-p1 to-p1]
+ [from-p2 to-p2 h1-p2 h2-p2]]
+
+ (let [theta (-> (mth/atan2 (- (:y to-p1) (:y from-p1))
+ (- (:x to-p1) (:x from-p1)))
+ (mth/degrees))
+
+ transform (-> (gmt/matrix)
+ (gmt/rotate (- theta))
+ (gmt/translate (gpt/negate from-p1)))
+
+ c2' [(gpt/transform from-p2 transform)
+ (gpt/transform to-p2 transform)
+ (gpt/transform h1-p2 transform)
+ (gpt/transform h2-p2 transform)]]
+
+ (curve-roots c2' :y)))
+
+
+
+(defn ray-line-intersect
+ [point [a b :as line]]
+
+ ;; If the ray is paralell to the line there will be no crossings
+ (let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
+ ;; Rays fail when fall just in a vertex so we move a bit upward
+ ;; because only want to use this for insideness
+ a (if (and (some? a) (s= (:y a) (:y point))) (update a :y + 10) a)
+ b (if (and (some? b) (s= (:y b) (:y point))) (update b :y + 10) b)
+ [ray-t line-t] (line-line-crossing ray-line [a b])]
+
+ (when (and (some? line-t) (some? ray-t)
+ (> ray-t 0)
+ (or (> line-t 0) (s= line-t 0))
+ (or (< line-t 1) (s= line-t 1)))
+ [[(line-values line line-t)
+ (line-windup line line-t)]])))
+
+(defn line-line-intersect
+ [l1 l2]
+
+ (let [[l1-t l2-t] (line-line-crossing l1 l2)]
+ (when (and (some? l1-t) (some? l2-t)
+ (or (> l1-t 0) (s= l1-t 0))
+ (or (< l1-t 1) (s= l1-t 1))
+ (or (> l2-t 0) (s= l2-t 0))
+ (or (< l2-t 1) (s= l2-t 1)))
+ [[l1-t] [l2-t]])))
+
+(defn ray-curve-intersect
+ [ray-line c2]
+
+ (let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))]
+ curve-ts (->> (line-curve-crossing ray-line c2)
+ (filterv #(let [curve-v (curve-values c2 %)
+ curve-tg (curve-tangent c2 %)
+ curve-tg-angle (gpt/angle curve-tg)
+ ray-t (get-line-tval ray-line curve-v)]
+ (and (> ray-t 0)
+ (> (mth/abs (- curve-tg-angle 180)) 0.01)
+ (> (mth/abs (- curve-tg-angle 0)) 0.01)) )))]
+ (->> curve-ts
+ (mapv #(vector (curve-values c2 %)
+ (curve-windup c2 %))))))
+
+(defn line-curve-intersect
+ [l1 c2]
+
+ (let [curve-ts (->> (line-curve-crossing l1 c2)
+ (filterv
+ (fn [curve-t]
+ (let [curve-t (if (mth/almost-zero? curve-t) 0 curve-t)
+ curve-v (curve-values c2 curve-t)
+ line-t (get-line-tval l1 curve-v)]
+ (and (>= curve-t 0) (<= curve-t 1)
+ (>= line-t 0) (<= line-t 1))))))
+
+ ;; Intersection line-curve points
+ intersect-ps (->> curve-ts
+ (mapv #(curve-values c2 %)))
+
+ line-ts (->> intersect-ps
+ (mapv #(get-line-tval l1 %)))]
+
+ [line-ts curve-ts]))
+
+(defn curve-curve-intersect
+ [c1 c2]
+
+ (letfn [(check-range [c1-from c1-to c2-from c2-to]
+ (let [r1 (curve-range->rect c1 c1-from c1-to)
+ r2 (curve-range->rect c2 c2-from c2-to)]
+
+ (when (gpr/overlaps-rects? r1 r2)
+ (let [p1 (curve-values c1 c1-from)
+ p2 (curve-values c2 c2-from)]
+
+ (if (< (gpt/distance p1 p2) curve-curve-precision)
+ [{:p1 p1
+ :p2 p2
+ :d (gpt/distance p1 p2)
+ :t1 (mth/precision c1-from 4)
+ :t2 (mth/precision c2-from 4)}]
+
+ (let [c1-half (+ c1-from (/ (- c1-to c1-from) 2))
+ c2-half (+ c2-from (/ (- c2-to c2-from) 2))
+
+ ts-1 (check-range c1-from c1-half c2-from c2-half)
+ ts-2 (check-range c1-from c1-half c2-half c2-to)
+ ts-3 (check-range c1-half c1-to c2-from c2-half)
+ ts-4 (check-range c1-half c1-to c2-half c2-to)]
+
+ (d/concat [] ts-1 ts-2 ts-3 ts-4)))))))
+
+ (remove-close-ts [{cp1 :p1 cp2 :p2}]
+ (fn [{:keys [p1 p2]}]
+ (and (>= (gpt/distance p1 cp1) curve-range-precision)
+ (>= (gpt/distance p2 cp2) curve-range-precision))))
+
+ (process-ts [ts]
+ (loop [current (first ts)
+ pending (rest ts)
+ c1-ts []
+ c2-ts []]
+
+ (if (nil? current)
+ [c1-ts c2-ts]
+
+ (let [pending (->> pending (filter (remove-close-ts current)))
+ c1-ts (conj c1-ts (:t1 current))
+ c2-ts (conj c2-ts (:t2 current))]
+ (recur (first pending)
+ (rest pending)
+ c1-ts
+ c2-ts)))))]
+
+ (->> (check-range 0 1 0 1)
+ (sort-by :d)
+ (process-ts))))
+
+(defn curve->rect
+ [[from-p to-p :as curve]]
+ (let [extremes (->> (curve-extremities curve)
+ (mapv #(curve-values curve %)))]
+ (gpr/points->rect (into [from-p to-p] extremes))))
+
+
+(defn is-point-in-border?
+ [point content]
+
+ (letfn [(inside-border? [cmd]
+ (case (:command cmd)
+ :line-to (segment-has-point? point (command->line cmd))
+ :curve-to (curve-has-point? point (command->bezier cmd))
+ #_:else false))]
+
+ (->> content
+ (some inside-border?))))
+
+(defn is-point-in-content?
+ [point content]
+ (let [selrect (content->selrect content)
+ ray-line [point (gpt/point (inc (:x point)) (:y point))]
+
+ closed-content
+ (into []
+ (comp (filter sp/is-closed?)
+ (mapcat :data))
+ (->> content
+ (sp/close-subpaths)
+ (sp/get-subpaths)))
+
+ cast-ray
+ (fn [cmd]
+ (case (:command cmd)
+ :line-to (ray-line-intersect point (command->line cmd))
+ :curve-to (ray-curve-intersect ray-line (command->bezier cmd))
+ #_:else []))]
+
+ (and (gpr/contains-point? selrect point)
+ (->> closed-content
+ (mapcat cast-ray)
+ (map second)
+ (reduce +)
+ (not= 0)))))
+
+(defn split-line-to
+ "Given a point and a line-to command will create a two new line-to commands
+ that will split the original line into two given a value between 0-1"
+ [from-p cmd t-val]
+ (let [to-p (upc/command->point cmd)
+ sp (gpt/lerp from-p to-p t-val)]
+ [(upc/make-line-to sp) cmd]))
+
+(defn split-curve-to
+ "Given the point and a curve-to command will split the curve into two new
+ curve-to commands given a value between 0-1"
+ [from-p cmd t-val]
+ (let [params (:params cmd)
+ end (gpt/point (:x params) (:y params))
+ h1 (gpt/point (:c1x params) (:c1y params))
+ h2 (gpt/point (:c2x params) (:c2y params))
+ [[_ to1 h11 h21]
+ [_ to2 h12 h22]] (curve-split from-p end h1 h2 t-val)]
+ [(upc/make-curve-to to1 h11 h21)
+ (upc/make-curve-to to2 h12 h22)]))
+
+(defn split-line-to-ranges
+ "Splits a line into several lines given the points in `values`
+ for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split
+ the line into 4 lines"
+ [from-p cmd values]
+ (let [values (->> values (filter #(and (> % 0) (< % 1))))]
+ (if (empty? values)
+ [cmd]
+ (let [to-p (upc/command->point cmd)
+ values-set (->> (conj values 1) (into (sorted-set)))]
+ (->> values-set
+ (mapv (fn [val]
+ (-> (gpt/lerp from-p to-p val)
+ #_(gpt/round 2)
+ (upc/make-line-to)))))))))
+
+(defn split-curve-to-ranges
+ "Splits a curve into several curves given the points in `values`
+ for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split
+ the curve into 4 curves that draw the same curve"
+ [from-p cmd values]
+
+ (let [values (->> values (filter #(and (> % 0) (< % 1))))]
+ (if (empty? values)
+ [cmd]
+ (let [to-p (upc/command->point cmd)
+ params (:params cmd)
+ h1 (gpt/point (:c1x params) (:c1y params))
+ h2 (gpt/point (:c2x params) (:c2y params))
+
+ values-set (->> (conj values 0 1) (into (sorted-set)))]
+
+ (->> (d/with-prev values-set)
+ (rest)
+ (mapv
+ (fn [[t1 t0]]
+ (let [[_ to-p h1' h2'] (subcurve-range from-p to-p h1 h2 t0 t1)]
+ (upc/make-curve-to (-> to-p #_(gpt/round 2)) h1' h2')))))))))
+
+(defn content-center
+ [content]
+ (-> content
+ content->selrect
+ gsc/center-selrect))
+
+(defn content->points+selrect
+ "Given the content of a shape, calculate its points and selrect"
+ [shape content]
+ (let [{:keys [flip-x flip-y]} shape
+ transform
+ (cond-> (:transform shape (gmt/matrix))
+ flip-x (gmt/scale (gpt/point -1 1))
+ flip-y (gmt/scale (gpt/point 1 -1)))
+
+ transform-inverse
+ (cond-> (gmt/matrix)
+ flip-x (gmt/scale (gpt/point -1 1))
+ flip-y (gmt/scale (gpt/point 1 -1))
+ :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
+
+ center (or (gsc/center-shape shape)
+ (content-center content))
+
+ base-content (transform-content
+ content
+ (gmt/transform-in center transform-inverse))
+
+ ;; Calculates the new selrect with points given the old center
+ points (-> (content->selrect base-content)
+ (gpr/rect->points)
+ (gsc/transform-points center transform))
+
+ points-center (gsc/center-points points)
+
+ ;; Points is now the selrect but the center is different so we can create the selrect
+ ;; through points
+ selrect (-> points
+ (gsc/transform-points points-center transform-inverse)
+ (gpr/points->selrect))]
+ [points selrect]))
+
+
+(defn open-path?
+ [shape]
+
+ (and (= :path (:type shape))
+ (not (->> shape
+ :content
+ (sp/close-subpaths)
+ (sp/get-subpaths)
+ (every? sp/is-closed?)))))
diff --git a/common/src/app/common/geom/shapes/rect.cljc b/common/src/app/common/geom/shapes/rect.cljc
index 91e7d18a9..047781a70 100644
--- a/common/src/app/common/geom/shapes/rect.cljc
+++ b/common/src/app/common/geom/shapes/rect.cljc
@@ -7,7 +7,8 @@
(ns app.common.geom.shapes.rect
(:require
[app.common.geom.point :as gpt]
- [app.common.geom.shapes.common :as gco]))
+ [app.common.geom.shapes.common :as gco]
+ [app.common.math :as mth]))
(defn rect->points [{:keys [x y width height]}]
;; (assert (number? x))
@@ -47,6 +48,16 @@
(defn rect->selrect [rect]
(-> rect rect->points points->selrect))
+(defn join-rects [rects]
+ (let [minx (transduce (comp (map :x) (remove nil?)) min ##Inf rects)
+ miny (transduce (comp (map :y) (remove nil?)) min ##Inf rects)
+ maxx (transduce (comp (map #(+ (:x %) (:width %))) (remove nil?)) max ##-Inf rects)
+ maxy (transduce (comp (map #(+ (:y %) (:height %))) (remove nil?)) max ##-Inf rects)]
+ {:x minx
+ :y miny
+ :width (- maxx minx)
+ :height (- maxy miny)}))
+
(defn join-selrects [selrects]
(let [minx (transduce (comp (map :x1) (remove nil?)) min ##Inf selrects)
miny (transduce (comp (map :y1) (remove nil?)) min ##Inf selrects)
@@ -70,3 +81,43 @@
:y (- (:y center) (/ height 2))
:width width
:height height})
+
+(defn s=
+ [a b]
+ (mth/almost-zero? (- a b)))
+
+(defn overlaps-rects?
+ "Check for two rects to overlap. Rects won't overlap only if
+ one of them is fully to the left or the top"
+ [rect-a rect-b]
+
+ (let [x1a (:x rect-a)
+ y1a (:y rect-a)
+ x2a (+ (:x rect-a) (:width rect-a))
+ y2a (+ (:y rect-a) (:height rect-a))
+
+ x1b (:x rect-b)
+ y1b (:y rect-b)
+ x2b (+ (:x rect-b) (:width rect-b))
+ y2b (+ (:y rect-b) (:height rect-b))]
+
+ (and (or (> x2a x1b) (s= x2a x1b))
+ (or (>= x2b x1a) (s= x2b x1a))
+ (or (<= y1b y2a) (s= y1b y2a))
+ (or (<= y1a y2b) (s= y1a y2b)))))
+
+(defn contains-point?
+ [rect point]
+ (assert (gpt/point? point))
+ (let [x1 (:x rect)
+ y1 (:y rect)
+ x2 (+ (:x rect) (:width rect))
+ y2 (+ (:y rect) (:height rect))
+
+ px (:x point)
+ py (:y point)]
+
+ (and (or (> px x1) (s= px x1))
+ (or (< px x2) (s= px x2))
+ (or (> py y1) (s= py y1))
+ (or (< py y2) (s= py y2)))))
diff --git a/common/src/app/common/geom/shapes/transforms.cljc b/common/src/app/common/geom/shapes/transforms.cljc
index 97250b361..bfb6a751f 100644
--- a/common/src/app/common/geom/shapes/transforms.cljc
+++ b/common/src/app/common/geom/shapes/transforms.cljc
@@ -18,7 +18,6 @@
[app.common.spec :as us]
[app.common.text :as txt]))
-
;; --- Relative Movement
(defn- move-selrect [selrect {dx :x dy :y}]
@@ -161,23 +160,12 @@
matrix
(gmt/translate-matrix (gpt/negate center)))))
-(defn transform-points
- ([points matrix]
- (transform-points points nil matrix))
- ([points center matrix]
- (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
- post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
-
- tr-point (fn [point]
- (gpt/transform point (gmt/multiply prev matrix post)))]
- (mapv tr-point points))))
-
(defn transform-rect
"Transform a rectangles and changes its attributes"
[rect matrix]
(let [points (-> (gpr/rect->points rect)
- (transform-points matrix))]
+ (gco/transform-points matrix))]
(gpr/points->rect points)))
(defn calculate-adjust-matrix
@@ -201,12 +189,12 @@
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
h1 (max 1 (calculate-height points-temp))
- h2 (max 1 (calculate-height (transform-points points-rec center stretch-matrix)))
+ h2 (max 1 (calculate-height (gco/transform-points points-rec center stretch-matrix)))
h3 (if-not (mth/almost-zero? h2) (/ h1 h2) 1)
h3 (if (mth/nan? h3) 1 h3)
w1 (max 1 (calculate-width points-temp))
- w2 (max 1 (calculate-width (transform-points points-rec center stretch-matrix)))
+ w2 (max 1 (calculate-width (gco/transform-points points-rec center stretch-matrix)))
w3 (if-not (mth/almost-zero? w2) (/ w1 w2) 1)
w3 (if (mth/nan? w3) 1 w3)
@@ -214,7 +202,7 @@
rotation-angle (calculate-rotation
center
- (transform-points points-rec (gco/center-points points-rec) stretch-matrix)
+ (gco/transform-points points-rec (gco/center-points points-rec) stretch-matrix)
points-temp
flip-x
flip-y)
@@ -232,14 +220,13 @@
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?]
- ;;
- (let [points (-> shape :points (transform-points transform))
+ (let [points (-> shape :points (gco/transform-points transform))
center (gco/center-points points)
;; Reverse the current transformation stack to get the base rectangle
tr-inverse (:transform-inverse shape (gmt/matrix))
- points-temp (transform-points points center tr-inverse)
+ points-temp (gco/transform-points points center tr-inverse)
points-temp-dim (calculate-dimensions points-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
@@ -305,12 +292,12 @@
points (->> children (mapcat :points))
;; Invert to get the points minus the transforms applied to the group
- base-points (transform-points points shape-center (:transform-inverse group (gmt/matrix)))
+ base-points (gco/transform-points points shape-center (:transform-inverse group (gmt/matrix)))
;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points)
(gpr/rect->points)
- (transform-points shape-center (:transform group (gmt/matrix))))
+ (gco/transform-points shape-center (:transform group (gmt/matrix))))
;; Calculte the new selrect
new-selrect (gpr/points->selrect base-points)]
@@ -457,8 +444,10 @@
transform))
(defn- set-flip [shape modifiers]
- (let [rx (get-in modifiers [:resize-vector :x])
- ry (get-in modifiers [:resize-vector :y])]
+ (let [rx (or (get-in modifiers [:resize-vector :x])
+ (get-in modifiers [:resize-vector-2 :x]))
+ ry (or (get-in modifiers [:resize-vector :y])
+ (get-in modifiers [:resize-vector-2 :y]))]
(cond-> shape
(and rx (< rx 0)) (-> (update :flip-x not)
(update :rotation -))
@@ -517,7 +506,7 @@
(defn calc-child-modifiers
"Given the modifiers to apply to the parent, calculate the corresponding
modifiers for the child, depending on the child constraints."
- [parent child parent-modifiers]
+ [parent child parent-modifiers ignore-constraints]
(let [parent-rect (:selrect parent)
child-rect (:selrect child)
@@ -544,15 +533,19 @@
transformed-parent-rect (-> parent-rect
(gpr/rect->points)
- (transform-points parent-displacement)
- (transform-points parent-origin (gmt/scale-matrix parent-vector))
- (transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
+ (gco/transform-points parent-displacement)
+ (gco/transform-points parent-origin (gmt/scale-matrix parent-vector))
+ (gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
(gpr/points->selrect))
;; Calculate the modifiers in the horizontal and vertical directions
;; depending on the child constraints.
- constraints-h (get child :constraints-h (spec/default-constraints-h child))
- constraints-v (get child :constraints-v (spec/default-constraints-v child))
+ constraints-h (if-not ignore-constraints
+ (get child :constraints-h (spec/default-constraints-h child))
+ :scale)
+ constraints-v (if-not ignore-constraints
+ (get child :constraints-v (spec/default-constraints-v child))
+ :scale)
modifiers-h (case constraints-h
:left
@@ -692,3 +685,12 @@
(assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers)))))
+
+(defn selection-rect
+ "Returns a rect that contains all the shapes and is aware of the
+ rotation of each shape. Mainly used for multiple selection."
+ [shapes]
+ (->> shapes
+ (transform-shape)
+ (map (comp gpr/points->selrect :points))
+ (gpr/join-selrects)))
diff --git a/common/src/app/common/logging.cljc b/common/src/app/common/logging.cljc
new file mode 100644
index 000000000..a861bcc27
--- /dev/null
+++ b/common/src/app/common/logging.cljc
@@ -0,0 +1,297 @@
+;; 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.common.logging
+ (:require
+ [app.common.exceptions :as ex]
+ [clojure.pprint :refer [pprint]]
+ [cuerdas.core :as str]
+ #?(:cljs [goog.log :as glog]))
+ #?(:cljs (:require-macros [app.common.logging]))
+ #?(:clj
+ (:import
+ org.apache.logging.log4j.Level
+ org.apache.logging.log4j.LogManager
+ org.apache.logging.log4j.Logger
+ org.apache.logging.log4j.ThreadContext
+ org.apache.logging.log4j.message.MapMessage
+ org.apache.logging.log4j.spi.LoggerContext)))
+
+#?(:clj
+ (defn build-map-message
+ [m]
+ (let [message (MapMessage. (count m))]
+ (reduce-kv #(.with ^MapMessage %1 (name %2) %3) message m))))
+
+#?(:clj
+ (def logger-context
+ (LogManager/getContext false)))
+
+#?(:clj
+ (def logging-agent
+ (agent nil :error-mode :continue)))
+
+(defn get-logger
+ [lname]
+ #?(:clj (.getLogger ^LoggerContext logger-context ^String lname)
+ :cljs
+ (glog/getLogger
+ (cond
+ (string? lname) lname
+ (= lname :root) ""
+ (simple-ident? lname) (name lname)
+ (qualified-ident? lname) (str (namespace lname) "." (name lname))
+ :else (str lname)))))
+
+(defn get-level
+ [level]
+ #?(:clj
+ (case level
+ :trace Level/TRACE
+ :debug Level/DEBUG
+ :info Level/INFO
+ :warn Level/WARN
+ :error Level/ERROR
+ :fatal Level/FATAL)
+ :cljs
+ (case level
+ :off (.-OFF ^js glog/Level)
+ :shout (.-SHOUT ^js glog/Level)
+ :error (.-SEVERE ^js glog/Level)
+ :severe (.-SEVERE ^js glog/Level)
+ :warning (.-WARNING ^js glog/Level)
+ :warn (.-WARNING ^js glog/Level)
+ :info (.-INFO ^js glog/Level)
+ :config (.-CONFIG ^js glog/Level)
+ :debug (.-FINE ^js glog/Level)
+ :fine (.-FINE ^js glog/Level)
+ :finer (.-FINER ^js glog/Level)
+ :trace (.-FINER ^js glog/Level)
+ :finest (.-FINEST ^js glog/Level)
+ :all (.-ALL ^js glog/Level))))
+
+(defn write-log!
+ [logger level exception message]
+ #?(:clj
+ (if exception
+ (.log ^Logger logger
+ ^Level level
+ ^Object message
+ ^Throwable exception)
+ (.log ^Logger logger
+ ^Level level
+ ^Object message))
+ :cljs
+ (when glog/ENABLED
+ (when-let [l (get-logger logger)]
+ (let [level (get-level level)
+ record (glog/LogRecord. level message (.getName ^js l))]
+ (when exception (.setException record exception))
+ (glog/publishLogRecord l record))))))
+
+#?(:clj
+ (defn enabled?
+ [logger level]
+ (.isEnabled ^Logger logger ^Level level)))
+
+(defmacro log
+ [& {:keys [level cause ::logger ::async ::raw] :as props}]
+ (if (:ns &env) ; CLJS
+ `(write-log! ~(or logger (str *ns*))
+ ~level
+ ~cause
+ ~(dissoc props :level :cause ::logger ::raw))
+ (let [props (dissoc props :level :cause ::logger ::async ::raw)
+ logger (or logger (str *ns*))
+ logger-sym (gensym "log")
+ level-sym (gensym "log")]
+ `(let [~logger-sym (get-logger ~logger)
+ ~level-sym (get-level ~level)]
+ (if (enabled? ~logger-sym ~level-sym)
+ ~(if async
+ `(send-off logging-agent
+ (fn [_#]
+ (let [message# (or ~raw (build-map-message ~props))]
+ (write-log! ~logger-sym ~level-sym ~cause message#))))
+ `(let [message# (or ~raw (build-map-message ~props))]
+ (write-log! ~logger-sym ~level-sym ~cause message#))))))))
+
+(defmacro info
+ [& params]
+ `(log :level :info ~@params))
+
+(defmacro error
+ [& params]
+ `(log :level :error ~@params))
+
+(defmacro warn
+ [& params]
+ `(log :level :warn ~@params))
+
+(defmacro debug
+ [& params]
+ `(log :level :debug ~@params))
+
+(defmacro trace
+ [& params]
+ `(log :level :trace ~@params))
+
+(defmacro set-level!
+ ([level]
+ (when (:ns &env)
+ `(set-level* ~(str *ns*) ~level)))
+ ([n level]
+ (when (:ns &env)
+ `(set-level* ~n ~level))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CLJ Specific
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:clj
+ (defn update-thread-context!
+ [data]
+ (run! (fn [[key val]]
+ (ThreadContext/put
+ (name key)
+ (cond
+ (coll? val)
+ (binding [clojure.pprint/*print-right-margin* 120]
+ (with-out-str (pprint val)))
+ (instance? clojure.lang.Named val) (name val)
+ :else (str val))))
+ data)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CLJS Specific
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:cljs
+ (def ^:private colors
+ {:gray3 "#8e908c"
+ :gray4 "#969896"
+ :gray5 "#4d4d4c"
+ :gray6 "#282a2e"
+ :black "#1d1f21"
+ :red "#c82829"
+ :blue "#4271ae"
+ :orange "#f5871f"}))
+
+#?(:cljs
+ (defn- level->color
+ [level]
+ (letfn [(get-level-value [l] (.-value ^js (get-level l)))]
+ (condp <= (get-level-value level)
+ (get-level-value :error) (get colors :red)
+ (get-level-value :warn) (get colors :orange)
+ (get-level-value :info) (get colors :blue)
+ (get-level-value :debug) (get colors :gray4)
+ (get-level-value :trace) (get colors :gray3)
+ (get colors :gray2)))))
+
+#?(:cljs
+ (defn- level->short-name
+ [l]
+ (case l
+ :fine "DBG"
+ :debug "DBG"
+ :finer "TRC"
+ :trace "TRC"
+ :info "INF"
+ :warn "WRN"
+ :warning "WRN"
+ :error "ERR"
+ (subs (.-name ^js (get-level l)) 0 3))))
+
+#?(:cljs
+ (defn set-level*
+ "Set the level (a keyword) of the given logger, identified by name."
+ [name lvl]
+ (some-> (get-logger name)
+ (glog/setLevel (get-level lvl)))))
+
+
+#?(:cljs
+ (defn set-levels!
+ [lvls]
+ (doseq [[logger level] lvls
+ :let [level (if (string? level) (keyword level) level)]]
+ (set-level* logger level))))
+
+#?(:cljs
+ (defn- prepare-message
+ [message]
+ (loop [kvpairs (seq message)
+ message (array-map)
+ specials []]
+ (if (nil? kvpairs)
+ [message specials]
+ (let [[k v] (first kvpairs)]
+ (cond
+ (= k :err)
+ (recur (next kvpairs)
+ message
+ (conj specials [:error nil v]))
+
+ (and (qualified-ident? k)
+ (= "js" (namespace k)))
+ (recur (next kvpairs)
+ message
+ (conj specials [:js (name k) (if (object? v) v (clj->js v))]))
+
+ :else
+ (recur (next kvpairs)
+ (assoc message k v)
+ specials)))))))
+
+#?(:cljs
+ (defn default-handler
+ [{:keys [message level logger-name]}]
+ (let [header-styles (str "font-weight: 600; color: " (level->color level))
+ normal-styles (str "font-weight: 300; color: " (get colors :gray6))
+ level-name (level->short-name level)
+ header (str "%c" level-name " [" logger-name "] ")]
+
+ (if (string? message)
+ (let [message (str header "%c" message)]
+ (js/console.log message header-styles normal-styles))
+ (let [[message specials] (prepare-message message)]
+ (if (seq specials)
+ (let [message (str header "%c" (pr-str message))]
+ (js/console.group message header-styles normal-styles)
+ (doseq [[type n v] specials]
+ (case type
+ :js (js/console.log n v)
+ :error (if (ex/ex-info? v)
+ (js/console.error (pr-str v))
+ (js/console.error v))))
+ (js/console.groupEnd message))
+ (let [message (str header "%c" (pr-str message))]
+ (js/console.log message header-styles normal-styles))))))))
+
+#?(:cljs
+ (defn record->map
+ [^js record]
+ {:seqn (.-sequenceNumber_ record)
+ :time (.-time_ record)
+ :level (keyword (str/lower (.-name (.-level_ record))))
+ :message (.-msg_ record)
+ :logger-name (.-loggerName_ record)
+ :exception (.-exception_ record)}))
+
+#?(:cljs
+ (defonce default-console-handler
+ (comp default-handler record->map)))
+
+#?(:cljs
+ (defn initialize!
+ []
+ (let [l (get-logger :root)]
+ (glog/removeHandler l default-console-handler)
+ (glog/addHandler l default-console-handler)
+ nil)))
+
+
diff --git a/common/src/app/common/math.cljc b/common/src/app/common/math.cljc
index 22ebd97af..67a327da8 100644
--- a/common/src/app/common/math.cljc
+++ b/common/src/app/common/math.cljc
@@ -72,17 +72,24 @@
[v]
(* v v))
+(defn pow
+ "Returns the base to the exponent power."
+ [b e]
+ #?(:cljs (js/Math.pow b e)
+ :clj (Math/pow b e)))
+
(defn sqrt
"Returns the square root of a number."
[v]
#?(:cljs (js/Math.sqrt v)
:clj (Math/sqrt v)))
-(defn pow
- "Returns the base to the exponent power."
- [b e]
- #?(:cljs (js/Math.pow b e)
- :clj (Math/pow b e)))
+(defn cubicroot
+ "Returns the cubic root of a number"
+ [v]
+ (if (pos? v)
+ (pow v (/ 1 3))
+ (- (pow (- v) (/ 1 3)))))
(defn floor
"Returns the largest integer less than or
@@ -143,7 +150,7 @@
(if (> num to) to num)))
(defn almost-zero? [num]
- (< (abs num) 1e-8))
+ (< (abs (double num)) 1e-5))
(defonce float-equal-precision 0.001)
@@ -151,3 +158,9 @@
"Equality for float numbers. Check if the difference is within a range"
[num1 num2]
(<= (abs (- num1 num2)) float-equal-precision))
+
+(defn lerp
+ "Calculates a the linear interpolation between two values and a given percent"
+ [v0 v1 t]
+ (+ (* (- 1 t) v0)
+ (* t v1)))
diff --git a/common/src/app/common/pages.cljc b/common/src/app/common/pages.cljc
index fdf02cfa3..00725454a 100644
--- a/common/src/app/common/pages.cljc
+++ b/common/src/app/common/pages.cljc
@@ -40,9 +40,11 @@
(d/export helpers/get-children)
(d/export helpers/get-children-objects)
(d/export helpers/get-object-with-children)
+(d/export helpers/select-children)
(d/export helpers/is-shape-grouped)
(d/export helpers/get-parent)
(d/export helpers/get-parents)
+(d/export helpers/get-frame)
(d/export helpers/clean-loops)
(d/export helpers/calculate-invalid-targets)
(d/export helpers/valid-frame-target)
@@ -66,13 +68,14 @@
(d/export helpers/merge-path-item)
(d/export helpers/compact-path)
(d/export helpers/compact-name)
+(d/export helpers/unframed-shape?)
;; Indices
(d/export indices/calculate-z-index)
(d/export indices/update-z-index)
(d/export indices/generate-child-all-parents-index)
(d/export indices/generate-child-parent-index)
-(d/export indices/create-mask-index)
+(d/export indices/create-clip-index)
;; Process changes
(d/export changes/process-changes)
diff --git a/common/src/app/common/pages/changes.cljc b/common/src/app/common/pages/changes.cljc
index 997edc170..a2211b238 100644
--- a/common/src/app/common/pages/changes.cljc
+++ b/common/src/app/common/pages/changes.cljc
@@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.shapes :as gsh]
+ [app.common.geom.shapes.bool :as gshb]
[app.common.pages.common :refer [component-sync-attrs]]
[app.common.pages.helpers :as cph]
[app.common.pages.init :as init]
@@ -156,7 +157,7 @@
(sequence (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map #(get objects %))
- (filter #(= (:type %) :group))
+ (filter #(contains? #{:group :bool} (:type %)))
(map :id)
(distinct))
shapes)))
@@ -177,6 +178,9 @@
(empty? children)
group
+ (= :bool (:type group))
+ (gshb/update-bool-selrect group children objects)
+
(:masked-group? group)
(set-mask-selrect group children)
diff --git a/common/src/app/common/pages/changes_builder.cljc b/common/src/app/common/pages/changes_builder.cljc
new file mode 100644
index 000000000..45fcebd23
--- /dev/null
+++ b/common/src/app/common/pages/changes_builder.cljc
@@ -0,0 +1,167 @@
+;; 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.common.pages.changes-builder
+ (:require
+ [app.common.data :as d]
+ [app.common.pages :as cp]
+ [app.common.pages.helpers :as h]))
+
+;; Auxiliary functions to help create a set of changes (undo + redo)
+
+(defn empty-changes [origin page-id]
+ (let [changes {:redo-changes []
+ :undo-changes []
+ :origin origin}]
+ (with-meta changes
+ {::page-id page-id})))
+
+(defn with-objects [changes objects]
+ (vary-meta changes assoc ::objects objects))
+
+(defn add-obj
+ ([changes obj index]
+ (add-obj changes (assoc obj ::index index)))
+
+ ([changes obj]
+ (let [add-change
+ {:type :add-obj
+ :id (:id obj)
+ :page-id (::page-id (meta changes))
+ :parent-id (:parent-id obj)
+ :frame-id (:frame-id obj)
+ :index (::index obj)
+ :obj (dissoc obj ::index :parent-id)}
+
+ del-change
+ {:type :del-obj
+ :id (:id obj)
+ :page-id (::page-id (meta changes))}]
+
+ (-> changes
+ (update :redo-changes conj add-change)
+ (update :undo-changes d/preconj del-change)))))
+
+(defn change-parent
+ [changes parent-id shapes]
+ (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
+
+ (let [objects (::objects (meta changes))
+ set-parent-change
+ {:type :mov-objects
+ :parent-id parent-id
+ :page-id (::page-id (meta changes))
+ :shapes (->> shapes (mapv :id))}
+
+ mk-undo-change
+ (fn [change-set shape]
+ (d/preconj
+ change-set
+ {:type :mov-objects
+ :page-id (::page-id (meta changes))
+ :parent-id (:parent-id shape)
+ :shapes [(:id shape)]
+ :index (cp/position-on-parent (:id shape) objects)}))]
+
+ (-> changes
+ (update :redo-changes conj set-parent-change)
+ (update :undo-changes #(reduce mk-undo-change % shapes)))))
+
+(defn- generate-operation
+ "Given an object old and new versions and an attribute will append into changes
+ the set and undo operations"
+ [changes attr old new ignore-geometry?]
+ (let [old-val (get old attr)
+ new-val (get new attr)]
+ (if (= old-val new-val)
+ changes
+ (-> changes
+ (update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
+ (update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
+
+(defn update-shapes
+ "Calculate the changes and undos to be done when a function is applied to a
+ single object"
+ ([changes ids update-fn]
+ (update-shapes changes ids update-fn nil))
+
+ ([changes ids update-fn {:keys [attrs ignore-geometry?] :or {attrs nil ignore-geometry? false}}]
+ (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
+ (let [objects (::objects (meta changes))
+
+ update-shape
+ (fn [changes id]
+ (let [old-obj (get objects id)
+ new-obj (update-fn old-obj)
+
+ attrs (or attrs (d/concat #{} (keys old-obj) (keys new-obj)))
+
+ {rops :rops uops :uops}
+ (reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
+ {:rops [] :uops []}
+ attrs)
+
+ uops (cond-> uops
+ (seq uops)
+ (conj {:type :set-touched :touched (:touched old-obj)}))
+
+ change {:type :mod-obj
+ :page-id (::page-id (meta changes))
+ :id id}]
+
+ (cond-> changes
+ (seq rops)
+ (update :redo-changes conj (assoc change :operations rops))
+
+ (seq uops)
+ (update :undo-changes d/preconj (assoc change :operations uops)))))]
+
+ (reduce update-shape changes ids))))
+
+(defn remove-objects
+ [changes ids]
+ (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
+ (let [page-id (::page-id (meta changes))
+ objects (::objects (meta changes))
+
+ add-redo-change
+ (fn [change-set id]
+ (conj change-set
+ {:type :del-obj
+ :page-id page-id
+ :id id}))
+
+ add-undo-change-shape
+ (fn [change-set id]
+ (let [shape (get objects id)]
+ (d/preconj
+ change-set
+ {:type :add-obj
+ :page-id page-id
+ :parent-id (:frame-id shape)
+ :frame-id (:frame-id shape)
+ :id id
+ :obj (cond-> shape
+ (contains? shape :shapes)
+ (assoc :shapes []))})))
+
+ add-undo-change-parent
+ (fn [change-set id]
+ (let [shape (get objects id)]
+ (d/preconj
+ change-set
+ {:type :mov-objects
+ :page-id page-id
+ :parent-id (:parent-id shape)
+ :shapes [id]
+ :index (h/position-on-parent id objects)
+ :ignore-touched true})))]
+
+ (-> changes
+ (update :redo-changes #(reduce add-redo-change % ids))
+ (update :undo-changes #(as-> % $
+ (reduce add-undo-change-parent $ ids)
+ (reduce add-undo-change-shape $ ids))))))
diff --git a/common/src/app/common/pages/helpers.cljc b/common/src/app/common/pages/helpers.cljc
index 6b30e3a9e..909908820 100644
--- a/common/src/app/common/pages/helpers.cljc
+++ b/common/src/app/common/pages/helpers.cljc
@@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.spec :as us]
+ [app.common.types.interactions :as cti]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
@@ -138,6 +139,10 @@
[id objects]
(mapv #(get objects %) (cons id (get-children id objects))))
+(defn select-children [id objects]
+ (->> (get-children id objects)
+ (select-keys objects)))
+
(defn is-shape-grouped
"Checks if a shape is inside a group"
[shape-id objects]
@@ -161,6 +166,12 @@
(when parent-id
(lazy-seq (cons parent-id (get-parents parent-id objects))))))
+(defn get-frame
+ "Get the frame that contains the shape. If the shape is already a frame, get itself."
+ [shape objects]
+ (if (= (:type shape) :frame)
+ shape
+ (get objects (:frame-id shape))))
(defn clean-loops
"Clean a list of ids from circular references."
@@ -466,3 +477,17 @@
(let [path-split (split-path path)]
(merge-path-item (first path-split) name)))
+(defn connected-frame?
+ "Check if some frame is origin or destination of any navigate interaction
+ in the page"
+ [frame-id objects]
+ (let [children (get-object-with-children frame-id objects)]
+ (or (some cti/flow-origin? (map :interactions children))
+ (some #(cti/flow-to? % frame-id) (map :interactions (vals objects))))))
+
+(defn unframed-shape?
+ "Checks if it's a non-frame shape in the top level."
+ [shape]
+ (and (not= (:type shape) :frame)
+ (= (:frame-id shape) uuid/zero)))
+
diff --git a/common/src/app/common/pages/indices.cljc b/common/src/app/common/pages/indices.cljc
index c1681fef1..5a5f40595 100644
--- a/common/src/app/common/pages/indices.cljc
+++ b/common/src/app/common/pages/indices.cljc
@@ -95,16 +95,24 @@
(map #(vector (:id %) (shape->parents %)))
(into {})))))
-(defn create-mask-index
+(defn create-clip-index
"Retrieves the mask information for an object"
[objects parents-index]
- (let [retrieve-masks
+ (let [retrieve-clips
(fn [_ parents]
- ;; TODO: use transducers?
- (->> parents
- (map #(get objects %))
- (filter #(:masked-group? %))
- ;; Retrieve the masking element
- (mapv #(get objects (->> % :shapes first)))))]
+ (let [lookup-object (fn [id] (get objects id))
+ get-clip-parents
+ (fn [shape]
+ (cond-> []
+ (:masked-group? shape)
+ (conj (get objects (->> shape :shapes first)))
+
+ (= :bool (:type shape))
+ (conj shape)))]
+
+ (into []
+ (comp (map lookup-object)
+ (mapcat get-clip-parents))
+ parents)))]
(->> parents-index
- (d/mapm retrieve-masks))))
+ (d/mapm retrieve-clips))))
diff --git a/common/src/app/common/pages/spec.cljc b/common/src/app/common/pages/spec.cljc
index aec112016..286148439 100644
--- a/common/src/app/common/pages/spec.cljc
+++ b/common/src/app/common/pages/spec.cljc
@@ -9,6 +9,8 @@
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.spec :as us]
+ [app.common.types.interactions :as cti]
+ [app.common.types.page-options :as cto]
[app.common.uuid :as uuid]
[clojure.set :as set]
[clojure.spec.alpha :as s]))
@@ -30,9 +32,6 @@
(s/def ::component-root? boolean?)
(s/def ::shape-ref uuid?)
-(s/def ::safe-integer ::us/safe-integer)
-(s/def ::safe-number ::us/safe-number)
-
(s/def :internal.matrix/a ::us/safe-number)
(s/def :internal.matrix/b ::us/safe-number)
(s/def :internal.matrix/c ::us/safe-number)
@@ -61,15 +60,15 @@
;; GRADIENTS
(s/def :internal.gradient.stop/color ::string)
-(s/def :internal.gradient.stop/opacity ::safe-number)
-(s/def :internal.gradient.stop/offset ::safe-number)
+(s/def :internal.gradient.stop/opacity ::us/safe-number)
+(s/def :internal.gradient.stop/offset ::us/safe-number)
(s/def :internal.gradient/type #{:linear :radial})
-(s/def :internal.gradient/start-x ::safe-number)
-(s/def :internal.gradient/start-y ::safe-number)
-(s/def :internal.gradient/end-x ::safe-number)
-(s/def :internal.gradient/end-y ::safe-number)
-(s/def :internal.gradient/width ::safe-number)
+(s/def :internal.gradient/start-x ::us/safe-number)
+(s/def :internal.gradient/start-y ::us/safe-number)
+(s/def :internal.gradient/end-x ::us/safe-number)
+(s/def :internal.gradient/end-y ::us/safe-number)
+(s/def :internal.gradient/width ::us/safe-number)
(s/def :internal.gradient/stop
(s/keys :req-un [:internal.gradient.stop/color
@@ -95,7 +94,7 @@
(s/def :internal.color/path (s/nilable ::string))
(s/def :internal.color/value (s/nilable ::string))
(s/def :internal.color/color (s/nilable ::string))
-(s/def :internal.color/opacity (s/nilable ::safe-number))
+(s/def :internal.color/opacity (s/nilable ::us/safe-number))
(s/def :internal.color/gradient (s/nilable ::gradient))
(s/def ::color
@@ -113,10 +112,10 @@
(s/def :internal.shadow/id uuid?)
(s/def :internal.shadow/style #{:drop-shadow :inner-shadow})
(s/def :internal.shadow/color ::color)
-(s/def :internal.shadow/offset-x ::safe-number)
-(s/def :internal.shadow/offset-y ::safe-number)
-(s/def :internal.shadow/blur ::safe-number)
-(s/def :internal.shadow/spread ::safe-number)
+(s/def :internal.shadow/offset-x ::us/safe-number)
+(s/def :internal.shadow/offset-y ::us/safe-number)
+(s/def :internal.shadow/blur ::us/safe-number)
+(s/def :internal.shadow/spread ::us/safe-number)
(s/def :internal.shadow/hidden boolean?)
(s/def :internal.shadow/shadow
@@ -137,7 +136,7 @@
(s/def :internal.blur/id uuid?)
(s/def :internal.blur/type #{:layer-blur})
-(s/def :internal.blur/value ::safe-number)
+(s/def :internal.blur/value ::us/safe-number)
(s/def :internal.blur/hidden boolean?)
(s/def ::blur
@@ -146,57 +145,6 @@
:internal.blur/value
:internal.blur/hidden]))
-;; Page Options
-(s/def :internal.page.grid.color/value string?)
-(s/def :internal.page.grid.color/opacity ::safe-number)
-
-(s/def :internal.page.grid/size ::safe-integer)
-(s/def :internal.page.grid/color
- (s/keys :req-un [:internal.page.grid.color/value
- :internal.page.grid.color/opacity]))
-
-(s/def :internal.page.grid/type #{:stretch :left :center :right})
-(s/def :internal.page.grid/item-length (s/nilable ::safe-integer))
-(s/def :internal.page.grid/gutter (s/nilable ::safe-integer))
-(s/def :internal.page.grid/margin (s/nilable ::safe-integer))
-
-(s/def :internal.page.grid/square
- (s/keys :req-un [:internal.page.grid/size
- :internal.page.grid/color]))
-
-(s/def :internal.page.grid/column
- (s/keys :req-un [:internal.page.grid/size
- :internal.page.grid/color
- :internal.page.grid/type
- :internal.page.grid/item-length
- :internal.page.grid/gutter
- :internal.page.grid/margin]))
-
-(s/def :internal.page.grid/row :internal.page.grid/column)
-
-(s/def :internal.page.options/background string?)
-(s/def :internal.page.options/saved-grids
- (s/keys :req-un [:internal.page.grid/square
- :internal.page.grid/row
- :internal.page.grid/column]))
-
-(s/def :internal.page/options
- (s/keys :opt-un [:internal.page.options/background]))
-
-;; Interactions
-
-(s/def :internal.shape.interaction/event-type #{:click}) ; In the future we will have more options
-(s/def :internal.shape.interaction/action-type #{:navigate})
-(s/def :internal.shape.interaction/destination ::uuid)
-
-(s/def :internal.shape/interaction
- (s/keys :req-un [:internal.shape.interaction/event-type
- :internal.shape.interaction/action-type
- :internal.shape.interaction/destination]))
-
-(s/def :internal.shape/interactions
- (s/coll-of :internal.shape/interaction :kind vector?))
-
;; Size constraints
(s/def :internal.shape/constraints-h #{:left :right :leftright :center :scale})
@@ -227,33 +175,33 @@
(s/def :internal.shape/content any?)
(s/def :internal.shape/fill-color string?)
-(s/def :internal.shape/fill-opacity ::safe-number)
+(s/def :internal.shape/fill-opacity ::us/safe-number)
(s/def :internal.shape/fill-color-gradient (s/nilable ::gradient))
(s/def :internal.shape/fill-color-ref-file (s/nilable uuid?))
(s/def :internal.shape/fill-color-ref-id (s/nilable uuid?))
(s/def :internal.shape/font-family string?)
-(s/def :internal.shape/font-size ::safe-integer)
+(s/def :internal.shape/font-size ::us/safe-integer)
(s/def :internal.shape/font-style string?)
(s/def :internal.shape/font-weight string?)
(s/def :internal.shape/hidden boolean?)
-(s/def :internal.shape/letter-spacing ::safe-number)
-(s/def :internal.shape/line-height ::safe-number)
+(s/def :internal.shape/letter-spacing ::us/safe-number)
+(s/def :internal.shape/line-height ::us/safe-number)
(s/def :internal.shape/locked boolean?)
(s/def :internal.shape/page-id uuid?)
-(s/def :internal.shape/proportion ::safe-number)
+(s/def :internal.shape/proportion ::us/safe-number)
(s/def :internal.shape/proportion-lock boolean?)
-(s/def :internal.shape/rx ::safe-number)
-(s/def :internal.shape/ry ::safe-number)
-(s/def :internal.shape/r1 ::safe-number)
-(s/def :internal.shape/r2 ::safe-number)
-(s/def :internal.shape/r3 ::safe-number)
-(s/def :internal.shape/r4 ::safe-number)
+(s/def :internal.shape/rx ::us/safe-number)
+(s/def :internal.shape/ry ::us/safe-number)
+(s/def :internal.shape/r1 ::us/safe-number)
+(s/def :internal.shape/r2 ::us/safe-number)
+(s/def :internal.shape/r3 ::us/safe-number)
+(s/def :internal.shape/r4 ::us/safe-number)
(s/def :internal.shape/stroke-color string?)
(s/def :internal.shape/stroke-color-gradient (s/nilable ::gradient))
(s/def :internal.shape/stroke-color-ref-file (s/nilable uuid?))
(s/def :internal.shape/stroke-color-ref-id (s/nilable uuid?))
-(s/def :internal.shape/stroke-opacity ::safe-number)
+(s/def :internal.shape/stroke-opacity ::us/safe-number)
(s/def :internal.shape/stroke-style #{:solid :dotted :dashed :mixed :none :svg})
(def stroke-caps-line #{:round :square})
@@ -266,26 +214,26 @@
[shape]
(= (:type shape) :path))
-(s/def :internal.shape/stroke-width ::safe-number)
+(s/def :internal.shape/stroke-width ::us/safe-number)
(s/def :internal.shape/stroke-alignment #{:center :inner :outer})
(s/def :internal.shape/text-align #{"left" "right" "center" "justify"})
-(s/def :internal.shape/x ::safe-number)
-(s/def :internal.shape/y ::safe-number)
-(s/def :internal.shape/cx ::safe-number)
-(s/def :internal.shape/cy ::safe-number)
-(s/def :internal.shape/width ::safe-number)
-(s/def :internal.shape/height ::safe-number)
+(s/def :internal.shape/x ::us/safe-number)
+(s/def :internal.shape/y ::us/safe-number)
+(s/def :internal.shape/cx ::us/safe-number)
+(s/def :internal.shape/cy ::us/safe-number)
+(s/def :internal.shape/width ::us/safe-number)
+(s/def :internal.shape/height ::us/safe-number)
(s/def :internal.shape/index integer?)
(s/def :internal.shape/shadow ::shadow)
(s/def :internal.shape/blur ::blur)
-(s/def :internal.shape/x1 ::safe-number)
-(s/def :internal.shape/y1 ::safe-number)
-(s/def :internal.shape/x2 ::safe-number)
-(s/def :internal.shape/y2 ::safe-number)
+(s/def :internal.shape/x1 ::us/safe-number)
+(s/def :internal.shape/y1 ::us/safe-number)
+(s/def :internal.shape/x2 ::us/safe-number)
+(s/def :internal.shape/y2 ::us/safe-number)
(s/def :internal.shape.export/suffix string?)
-(s/def :internal.shape.export/scale ::safe-number)
+(s/def :internal.shape.export/scale ::us/safe-number)
(s/def :internal.shape/export
(s/keys :req-un [::type
:internal.shape.export/suffix
@@ -361,7 +309,7 @@
:internal.shape/transform-inverse
:internal.shape/width
:internal.shape/height
- :internal.shape/interactions
+ ::cti/interactions
:internal.shape/masked-group?
:internal.shape/shadow
:internal.shape/blur]))
@@ -386,7 +334,7 @@
(s/def ::page
(s/keys :req-un [::id
::name
- :internal.page/options
+ ::cto/options
:internal.page/objects]))
@@ -397,8 +345,8 @@
:internal.color/gradient]))
(s/def :internal.media-object/name ::string)
-(s/def :internal.media-object/width ::safe-integer)
-(s/def :internal.media-object/height ::safe-integer)
+(s/def :internal.media-object/width ::us/safe-integer)
+(s/def :internal.media-object/height ::us/safe-integer)
(s/def :internal.media-object/mtype ::string)
(s/def ::media-object
diff --git a/common/src/app/common/path/bool.cljc b/common/src/app/common/path/bool.cljc
new file mode 100644
index 000000000..ddb388091
--- /dev/null
+++ b/common/src/app/common/path/bool.cljc
@@ -0,0 +1,309 @@
+;; 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.common.path.bool
+ (:require
+ [app.common.data :as d]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes.path :as gsp]
+ [app.common.geom.shapes.rect :as gpr]
+ [app.common.path.commands :as upc]
+ [app.common.path.subpaths :as ups]))
+
+(defn add-previous
+ ([content]
+ (add-previous content nil))
+ ([content first]
+ (->> (d/with-prev content)
+ (mapv (fn [[cmd prev]]
+ (cond-> cmd
+ (and (nil? prev) (some? first))
+ (assoc :prev first)
+
+ (some? prev)
+ (assoc :prev (gsp/command->point prev))))))))
+
+(defn close-paths
+ "Removes the :close-path commands and replace them for line-to so we can calculate
+ the intersections"
+ [content]
+
+ (loop [head (first content)
+ content (rest content)
+ result []
+ last-move nil
+ last-p nil]
+
+ (if (nil? head)
+ result
+ (let [head-p (gsp/command->point head)
+ head (cond
+ (and (= :close-path (:command head))
+ (< (gpt/distance last-p last-move) 0.01))
+ nil
+
+ (= :close-path (:command head))
+ (upc/make-line-to last-move)
+
+ :else
+ head)]
+
+ (recur (first content)
+ (rest content)
+ (cond-> result (some? head) (conj head))
+ (if (= :move-to (:command head))
+ head-p
+ last-move)
+ head-p)))))
+
+(defn- split-command
+ [cmd values]
+ (case (:command cmd)
+ :line-to (gsp/split-line-to-ranges (:prev cmd) cmd values)
+ :curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
+ [cmd]))
+
+(defn split-ts [seg-1 seg-2]
+ (cond
+ (and (= :line-to (:command seg-1))
+ (= :line-to (:command seg-2)))
+ (gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
+
+ (and (= :line-to (:command seg-1))
+ (= :curve-to (:command seg-2)))
+ (gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
+
+ (and (= :curve-to (:command seg-1))
+ (= :line-to (:command seg-2)))
+ (let [[seg-2' seg-1']
+ (gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
+ ;; Need to reverse because we send the arguments reversed
+ [seg-1' seg-2'])
+
+ (and (= :curve-to (:command seg-1))
+ (= :curve-to (:command seg-2)))
+ (gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
+
+ :else
+ [[] []]))
+
+(defn split
+ [seg-1 seg-2]
+ (let [r1 (gsp/command->selrect seg-1)
+ r2 (gsp/command->selrect seg-2)]
+ (if (not (gpr/overlaps-rects? r1 r2))
+ [[seg-1] [seg-2]]
+ (let [[ts-seg-1 ts-seg-2] (split-ts seg-1 seg-2)]
+ [(-> (split-command seg-1 ts-seg-1) (add-previous (:prev seg-1)))
+ (-> (split-command seg-2 ts-seg-2) (add-previous (:prev seg-2)))]))))
+
+(defn content-intersect-split
+ [content-a content-b]
+
+ (let [cache (atom {})]
+ (letfn [(split-cache [seg-1 seg-2]
+ (cond
+ (contains? @cache [seg-1 seg-2])
+ (first (get @cache [seg-1 seg-2]))
+
+ (contains? @cache [seg-2 seg-1])
+ (second (get @cache [seg-2 seg-1]))
+
+ :else
+ (let [value (split seg-1 seg-2)]
+ (swap! cache assoc [seg-1 seg-2] value)
+ (first value))))
+
+ (split-segment-on-content
+ [segment content]
+
+ (loop [current (first content)
+ content (rest content)
+ result [segment]]
+
+ (if (nil? current)
+ result
+ (let [result (->> result (into [] (mapcat #(split-cache % current))))]
+ (recur (first content)
+ (rest content)
+ result)))))
+
+ (split-content
+ [content-a content-b]
+ (into []
+ (mapcat #(split-segment-on-content % content-b))
+ content-a))]
+
+ [(split-content content-a content-b)
+ (split-content content-b content-a)])))
+
+(defn is-segment?
+ [cmd]
+ (and (contains? cmd :prev)
+ (contains? #{:line-to :curve-to} (:command cmd))))
+
+(defn contains-segment?
+ [segment content]
+
+ (let [point (case (:command segment)
+ :line-to (-> (gsp/command->line segment)
+ (gsp/line-values 0.5))
+
+ :curve-to (-> (gsp/command->bezier segment)
+ (gsp/curve-values 0.5)))]
+
+ (or (gsp/is-point-in-content? point content)
+ (gsp/is-point-in-border? point content))))
+
+(defn inside-segment?
+ [segment content]
+ (let [point (case (:command segment)
+ :line-to (-> (gsp/command->line segment)
+ (gsp/line-values 0.5))
+
+ :curve-to (-> (gsp/command->bezier segment)
+ (gsp/curve-values 0.5)))]
+
+ (gsp/is-point-in-content? point content)))
+
+(defn overlap-segment?
+ "Finds if the current segment is overlapping against other
+ segment meaning they have the same coordinates"
+ [segment content]
+
+ (let [overlap-single?
+ (fn [other]
+ (when (and (= (:command segment) (:command other))
+ (contains? #{:line-to :curve-to} (:command segment)))
+
+ (case (:command segment)
+ :line-to (let [[p1 q1] (gsp/command->line segment)
+ [p2 q2] (gsp/command->line other)]
+
+ (when (or (and (< (gpt/distance p1 p2) 0.1)
+ (< (gpt/distance q1 q2) 0.1))
+ (and (< (gpt/distance p1 q2) 0.1)
+ (< (gpt/distance q1 p2) 0.1)))
+ [segment other]))
+
+ :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
+ [p2 q2 h12 h22] (gsp/command->bezier other)]
+
+ (when (or (and (< (gpt/distance p1 p2) 0.1)
+ (< (gpt/distance q1 q2) 0.1)
+ (< (gpt/distance h11 h12) 0.1)
+ (< (gpt/distance h21 h22) 0.1))
+
+ (and (< (gpt/distance p1 q2) 0.1)
+ (< (gpt/distance q1 p2) 0.1)
+ (< (gpt/distance h11 h22) 0.1)
+ (< (gpt/distance h21 h12) 0.1)))
+
+ [segment other])))))]
+
+ (->> content
+ (d/seek overlap-single?)
+ (some?))))
+
+(defn create-union [content-a content-a-split content-b content-b-split]
+ ;; Pick all segments in content-a that are not inside content-b
+ ;; Pick all segments in content-b that are not inside content-a
+ (let [content
+ (d/concat
+ []
+ (->> content-a-split (filter #(not (contains-segment? % content-b))))
+ (->> content-b-split (filter #(not (contains-segment? % content-a)))))
+
+ ;; Overlapping segments should be added when they are part of the border
+ border-content
+ (->> content-b-split
+ (filterv #(and (contains-segment? % content-a)
+ (overlap-segment? % content-a-split)
+ (not (inside-segment? % content)))))]
+
+ (d/concat content border-content)))
+
+(defn create-difference [content-a content-a-split content-b content-b-split]
+ ;; Pick all segments in content-a that are not inside content-b
+ ;; Pick all segments in content b that are inside content-a
+ ;; removing overlapping
+ (d/concat
+ []
+ (->> content-a-split (filter #(not (contains-segment? % content-b))))
+
+ ;; Reverse second content so we can have holes inside other shapes
+ (->> content-b-split
+ (filter #(and (contains-segment? % content-a)
+ (not (overlap-segment? % content-a-split)))))))
+
+(defn create-intersection [content-a content-a-split content-b content-b-split]
+ ;; Pick all segments in content-a that are inside content-b
+ ;; Pick all segments in content-b that are inside content-a
+ (d/concat
+ []
+ (->> content-a-split (filter #(contains-segment? % content-b)))
+ (->> content-b-split (filter #(contains-segment? % content-a)))))
+
+
+(defn create-exclusion [content-a content-b]
+ ;; Pick all segments
+ (d/concat [] content-a content-b))
+
+
+(defn fix-move-to
+ [content]
+ ;; Remove the field `:prev` and makes the necesaries `move-to`
+ ;; then clean the subpaths
+
+ (loop [current (first content)
+ content (rest content)
+ prev nil
+ result []]
+
+ (if (nil? current)
+ result
+
+ (let [result (if (not= (:prev current) prev)
+ (conj result (upc/make-move-to (:prev current)))
+ result)]
+ (recur (first content)
+ (rest content)
+ (gsp/command->point current)
+ (conj result (dissoc current :prev)))))))
+
+(defn content-bool-pair
+ [bool-type content-a content-b]
+
+ (let [content-a (-> content-a (close-paths) (add-previous))
+
+ content-b (-> content-b
+ (close-paths)
+ (cond-> (ups/clockwise? content-b)
+ (ups/reverse-content))
+ (add-previous))
+
+ ;; Split content in new segments in the intersection with the other path
+ [content-a-split content-b-split] (content-intersect-split content-a content-b)
+ content-a-split (->> content-a-split add-previous (filter is-segment?))
+ content-b-split (->> content-b-split add-previous (filter is-segment?))
+
+ bool-content
+ (case bool-type
+ :union (create-union content-a content-a-split content-b content-b-split)
+ :difference (create-difference content-a content-a-split content-b content-b-split)
+ :intersection (create-intersection content-a content-a-split content-b content-b-split)
+ :exclude (create-exclusion content-a-split content-b-split))]
+
+ (->> (fix-move-to bool-content)
+ (ups/close-subpaths))))
+
+(defn content-bool
+ [bool-type contents]
+ ;; We apply the boolean operation in to each pair and the result to the next
+ ;; element
+ (->> contents
+ (reduce (partial content-bool-pair bool-type))
+ (into [])))
diff --git a/frontend/src/app/util/path/commands.cljs b/common/src/app/common/path/commands.cljc
similarity index 99%
rename from frontend/src/app/util/path/commands.cljs
rename to common/src/app/common/path/commands.cljc
index 84a7725ef..80737db8c 100644
--- a/frontend/src/app/util/path/commands.cljs
+++ b/common/src/app/common/path/commands.cljc
@@ -4,7 +4,7 @@
;;
;; Copyright (c) UXBOX Labs SL
-(ns app.util.path.commands
+(ns app.common.path.commands
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]))
@@ -199,3 +199,4 @@
(if (= prefix :c1)
(command->point (get content (dec index)))
(command->point (get content index))))
+
diff --git a/common/src/app/common/path/shapes_to_path.cljc b/common/src/app/common/path/shapes_to_path.cljc
new file mode 100644
index 000000000..d2f905914
--- /dev/null
+++ b/common/src/app/common/path/shapes_to_path.cljc
@@ -0,0 +1,227 @@
+;; 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.common.path.shapes-to-path
+ (:require
+ [app.common.data :as d]
+ [app.common.geom.matrix :as gmt]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes.common :as gsc]
+ [app.common.geom.shapes.path :as gsp]
+ [app.common.path.bool :as pb]
+ [app.common.path.commands :as pc]))
+
+(def ^:const bezier-circle-c 0.551915024494)
+
+(def dissoc-attrs
+ [:x :y :width :height
+ :rx :ry :r1 :r2 :r3 :r4
+ :metadata :shapes])
+
+(def allowed-transform-types
+ #{:rect
+ :circle
+ :image})
+
+(def style-group-properties
+ [:shadow
+ :blur])
+
+(def style-properties
+ (d/concat
+ style-group-properties
+ [:fill-color
+ :fill-opacity
+ :fill-color-gradient
+ :fill-color-ref-file
+ :fill-color-ref-id
+ :fill-image
+ :stroke-color
+ :stroke-color-ref-file
+ :stroke-color-ref-id
+ :stroke-opacity
+ :stroke-style
+ :stroke-width
+ :stroke-alignment
+ :stroke-cap-start
+ :stroke-cap-end]))
+
+(defn make-corner-arc
+ "Creates a curvle corner for border radius"
+ [from to corner radius]
+ (let [x (case corner
+ :top-left (:x from)
+ :top-right (- (:x from) radius)
+ :bottom-right (- (:x to) radius)
+ :bottom-left (:x to))
+
+ y (case corner
+ :top-left (- (:y from) radius)
+ :top-right (:y from)
+ :bottom-right (- (:y to) (* 2 radius))
+ :bottom-left (- (:y to) radius))
+
+ width (* radius 2)
+ height (* radius 2)
+
+ c bezier-circle-c
+ c1x (+ x (* (/ width 2) (- 1 c)))
+ c2x (+ x (* (/ width 2) (+ 1 c)))
+ c1y (+ y (* (/ height 2) (- 1 c)))
+ c2y (+ y (* (/ height 2) (+ 1 c)))
+
+ h1 (case corner
+ :top-left (assoc from :y c1y)
+ :top-right (assoc from :x c2x)
+ :bottom-right (assoc from :y c2y)
+ :bottom-left (assoc from :x c1x))
+
+ h2 (case corner
+ :top-left (assoc to :x c1x)
+ :top-right (assoc to :y c1y)
+ :bottom-right (assoc to :x c2x)
+ :bottom-left (assoc to :y c2y))]
+
+ (pc/make-curve-to to h1 h2)))
+
+(defn circle->path
+ "Creates the bezier curves to approximate a circle shape"
+ [x y width height]
+ (let [mx (+ x (/ width 2))
+ my (+ y (/ height 2))
+ ex (+ x width)
+ ey (+ y height)
+
+ p1 (gpt/point mx y)
+ p2 (gpt/point ex my)
+ p3 (gpt/point mx ey)
+ p4 (gpt/point x my)
+
+ c bezier-circle-c
+ c1x (+ x (* (/ width 2) (- 1 c)))
+ c2x (+ x (* (/ width 2) (+ 1 c)))
+ c1y (+ y (* (/ height 2) (- 1 c)))
+ c2y (+ y (* (/ height 2) (+ 1 c)))]
+
+ [(pc/make-move-to p1)
+ (pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
+ (pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
+ (pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
+ (pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
+
+(defn rect->path
+ "Creates a bezier curve that approximates a rounded corner rectangle"
+ [x y width height r1 r2 r3 r4 rx]
+ (let [[r1 r2 r3 r4] (->> [r1 r2 r3 r4] (mapv #(or % rx 0)))
+ p1 (gpt/point x (+ y r1))
+ p2 (gpt/point (+ x r1) y)
+
+ p3 (gpt/point (+ width x (- r2)) y)
+ p4 (gpt/point (+ width x) (+ y r2))
+
+ p5 (gpt/point (+ width x) (+ height y (- r3)))
+ p6 (gpt/point (+ width x (- r3)) (+ height y))
+
+ p7 (gpt/point (+ x r4) (+ height y))
+ p8 (gpt/point x (+ height y (- r4)))]
+ (-> []
+ (conj (pc/make-move-to p1))
+ (cond-> (not= p1 p2)
+ (conj (make-corner-arc p1 p2 :top-left r1)))
+ (conj (pc/make-line-to p3))
+ (cond-> (not= p3 p4)
+ (conj (make-corner-arc p3 p4 :top-right r2)))
+ (conj (pc/make-line-to p5))
+ (cond-> (not= p5 p6)
+ (conj (make-corner-arc p5 p6 :bottom-right r3)))
+ (conj (pc/make-line-to p7))
+ (cond-> (not= p7 p8)
+ (conj (make-corner-arc p7 p8 :bottom-left r4)))
+ (conj (pc/make-line-to p1)))))
+
+(declare convert-to-path)
+
+(defn fix-first-relative
+ "Fix an issue with the simplify commands not changing the first relative"
+ [content]
+ (let [head (first content)]
+ (cond-> content
+ (and head (:relative head))
+ (update 0 assoc :relative false))))
+
+(defn group-to-path
+ [group objects]
+ (let [xform (comp (map #(get objects %))
+ (map #(-> (convert-to-path % objects))))
+
+ child-as-paths (into [] xform (:shapes group))
+ head (last child-as-paths)
+ head-data (select-keys head style-properties)
+ content (into []
+ (comp (filter #(= :path (:type %)))
+ (mapcat #(fix-first-relative (:content %))))
+ child-as-paths)]
+ (-> group
+ (assoc :type :path)
+ (assoc :content content)
+ (merge head-data)
+ (d/without-keys dissoc-attrs))))
+
+(defn bool-to-path
+ [shape objects]
+
+ (let [children (->> (:shapes shape)
+ (map #(get objects %))
+ (map #(convert-to-path % objects)))
+ bool-type (:bool-type shape)
+ head (if (= bool-type :difference) (first children) (last children))
+ head (cond-> head
+ (and (contains? head :svg-attrs) (nil? (:fill-color head)))
+ (assoc :fill-color "#000000"))
+
+ head-data (select-keys head style-properties)
+ content (pb/content-bool (:bool-type shape) (mapv :content children))]
+
+ (-> shape
+ (assoc :type :path)
+ (assoc :content content)
+ (merge head-data)
+ (d/without-keys dissoc-attrs))))
+
+(defn convert-to-path
+ "Transforms the given shape to a path"
+ ([shape]
+ (convert-to-path shape {}))
+ ([{:keys [type x y width height r1 r2 r3 r4 rx metadata] :as shape} objects]
+ (assert (map? objects))
+ (case (:type shape)
+ :group
+ (group-to-path shape objects)
+
+ :bool
+ (bool-to-path shape objects)
+
+ (:rect :circle :image :text)
+ (let [new-content
+ (case type
+ :circle (circle->path x y width height)
+ #_:else (rect->path x y width height r1 r2 r3 r4 rx))
+
+ ;; Apply the transforms that had the shape
+ transform (:transform shape)
+ new-content (cond-> new-content
+ (some? transform)
+ (gsp/transform-content (gmt/transform-in (gsc/center-shape shape) transform)))]
+
+ (-> shape
+ (assoc :type :path)
+ (assoc :content new-content)
+ (cond-> (= :image type)
+ (assoc :fill-image metadata))
+ (d/without-keys dissoc-attrs)))
+
+ ;; For the rest return the plain shape
+ shape)))
diff --git a/frontend/src/app/util/path/subpaths.cljs b/common/src/app/common/path/subpaths.cljc
similarity index 66%
rename from frontend/src/app/util/path/subpaths.cljs
rename to common/src/app/common/path/subpaths.cljc
index 010f1343a..202e273b1 100644
--- a/frontend/src/app/util/path/subpaths.cljs
+++ b/common/src/app/common/path/subpaths.cljc
@@ -4,10 +4,16 @@
;;
;; Copyright (c) UXBOX Labs SL
-(ns app.util.path.subpaths
+(ns app.common.path.subpaths
(:require
[app.common.data :as d]
- [app.util.path.commands :as upc]))
+ [app.common.geom.point :as gpt]
+ [app.common.path.commands :as upc]))
+
+(defn pt=
+ "Check if two points are close"
+ [p1 p2]
+ (< (gpt/distance p1 p2) 0.1))
(defn make-subpath
"Creates a subpath either from a single command or with all the data"
@@ -67,16 +73,22 @@
(fn [subpaths current]
(let [is-move? (= :move-to (:command current))
last-idx (dec (count subpaths))]
- (if is-move?
+ (cond
+ is-move?
(conj subpaths (make-subpath current))
- (update subpaths last-idx add-subpath-command current))))]
+
+ (>= last-idx 0)
+ (update subpaths last-idx add-subpath-command current)
+
+ :else
+ subpaths)))]
(->> content
(reduce reduce-subpath []))))
(defn subpaths-join
"Join two subpaths together when the first finish where the second starts"
[subpath other]
- (assert (= (:to subpath) (:from other)))
+ (assert (pt= (:to subpath) (:from other)))
(-> subpath
(update :data d/concat (rest (:data other)))
(assoc :to (:to other))))
@@ -88,21 +100,31 @@
(let [merge-with-candidate
(fn [[candidate result] current]
(cond
- (= (:to current) (:from current))
+ (pt= (:to current) (:from current))
+ ;; Subpath is already a closed path
[candidate (conj result current)]
- (= (:to candidate) (:from current))
+ (pt= (:to candidate) (:from current))
[(subpaths-join candidate current) result]
- (= (:to candidate) (:to current))
+ (pt= (:from candidate) (:to current))
+ [(subpaths-join current candidate) result]
+
+ (pt= (:to candidate) (:to current))
[(subpaths-join candidate (reverse-subpath current)) result]
+ (pt= (:from candidate) (:from current))
+ [(subpaths-join (reverse-subpath current) candidate) result]
+
:else
[candidate (conj result current)]))]
(->> subpaths
(reduce merge-with-candidate [candidate []]))))
+(defn is-closed? [subpath]
+ (pt= (:from subpath) (:to subpath)))
+
(defn close-subpaths
"Searches a path for posible supaths that can create closed loops and merge them"
[content]
@@ -114,7 +136,7 @@
(if (some? current)
(let [[new-current new-subpaths]
- (if (= (:from current) (:to current))
+ (if (is-closed? current)
[current subpaths]
(merge-paths current subpaths))]
@@ -134,3 +156,38 @@
(->> closed-subpaths
(mapcat :data)
(into []))))
+
+(defn reverse-content
+ "Given a content reverse the order of the commands"
+ [content]
+
+ (->> content
+ (get-subpaths)
+ (mapv reverse-subpath)
+ (reverse)
+ (mapcat :data)
+ (into [])))
+
+;; https://mathworld.wolfram.com/PolygonArea.html
+(defn clockwise?
+ "Check whether the first subpath is clockwise or counter-clock wise"
+ [content]
+ (let [subpath (->> content get-subpaths first :data)]
+ (loop [current (first subpath)
+ subpath (rest subpath)
+ first-point nil
+ signed-area 0]
+
+ (if (nil? current)
+ (> signed-area 0)
+
+ (let [{x1 :x y1 :y :as p} (upc/command->point current)
+ last? (nil? (first subpath))
+ first-point (if (nil? first-point) p first-point)
+ {x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
+ signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
+
+ (recur (first subpath)
+ (rest subpath)
+ first-point
+ signed-area))))))
diff --git a/common/src/app/common/spec.cljc b/common/src/app/common/spec.cljc
index ca369fb51..88f8eab9a 100644
--- a/common/src/app/common/spec.cljc
+++ b/common/src/app/common/spec.cljc
@@ -111,6 +111,16 @@
(s/def ::point gpt/point?)
(s/def ::id ::uuid)
+(s/def ::words
+ (s/conformer
+ (fn [s]
+ (cond
+ (set? s) s
+ (string? s) (into #{} (map keyword) (str/words s))
+ :else ::s/invalid))
+ (fn [s]
+ (str/join " " (map name s)))))
+
(defn bytes?
"Test if a first parameter is a byte
array or not."
@@ -196,7 +206,7 @@
:name (pr-str spec)
:line (:line &env)
:file (:file (:meta nsdata))})
- message (str "Spec Assertion: '" (pr-str spec) "'")]
+ message (str "spec assert: '" (pr-str spec) "'")]
`(spec-assert* ~spec ~x ~message ~context))))
(defmacro verify
@@ -208,7 +218,7 @@
:name (pr-str spec)
:line (:line &env)
:file (:file (:meta nsdata))})
- message (str "Spec Assertion: '" (pr-str spec) "'")]
+ message (str "spec verify: '" (pr-str spec) "'")]
`(spec-assert* ~spec ~x ~message ~context)))
;; --- Public Api
diff --git a/common/src/app/common/types/interactions.cljc b/common/src/app/common/types/interactions.cljc
new file mode 100644
index 000000000..ebbc81e70
--- /dev/null
+++ b/common/src/app/common/types/interactions.cljc
@@ -0,0 +1,376 @@
+;; 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.common.types.interactions
+ (:require
+ [app.common.data :as d]
+ [app.common.geom.point :as gpt]
+ [app.common.spec :as us]
+ [clojure.spec.alpha :as s]))
+
+;; WARNING: options are not deleted when changing event or action type, so it can be
+;; restored if the user changes it back later.
+;;
+;; But that means that an interaction may have for example a delay or
+;; destination, even if its type does not require it (but a previous type did).
+;;
+;; So make sure to use has-delay/has-destination... functions, or similar,
+;; before reading them.
+
+;; -- Options depending on event type
+
+(s/def ::event-type #{:click
+ :mouse-press
+ :mouse-over
+ :mouse-enter
+ :mouse-leave
+ :after-delay})
+
+(s/def ::delay ::us/safe-integer)
+
+(defmulti event-opts-spec :event-type)
+
+(defmethod event-opts-spec :after-delay [_]
+ (s/keys :req-un [::delay]))
+
+(defmethod event-opts-spec :default [_]
+ (s/keys :req-un []))
+
+(s/def ::event-opts
+ (s/multi-spec event-opts-spec ::event-type))
+
+;; -- Options depending on action type
+
+(s/def ::action-type #{:navigate
+ :open-overlay
+ :toggle-overlay
+ :close-overlay
+ :prev-screen
+ :open-url})
+
+(s/def ::destination (s/nilable ::us/uuid))
+(s/def ::overlay-pos-type #{:manual
+ :center
+ :top-left
+ :top-right
+ :top-center
+ :bottom-left
+ :bottom-right
+ :bottom-center})
+(s/def ::overlay-position ::us/point)
+(s/def ::url ::us/string)
+(s/def ::close-click-outside ::us/boolean)
+(s/def ::background-overlay ::us/boolean)
+
+(defmulti action-opts-spec :action-type)
+
+(defmethod action-opts-spec :navigate [_]
+ (s/keys :req-un [::destination]))
+
+(defmethod action-opts-spec :open-overlay [_]
+ (s/keys :req-un [::destination
+ ::overlay-position
+ ::overlay-pos-type]
+ :opt-un [::close-click-outside
+ ::background-overlay]))
+
+(defmethod action-opts-spec :toggle-overlay [_]
+ (s/keys :req-un [::destination
+ ::overlay-position
+ ::overlay-pos-type]
+ :opt-un [::close-click-outside
+ ::background-overlay]))
+
+(defmethod action-opts-spec :close-overlay [_]
+ (s/keys :req-un [::destination]))
+
+(defmethod action-opts-spec :prev-screen [_]
+ (s/keys :req-un []))
+
+(defmethod action-opts-spec :open-url [_]
+ (s/keys :req-un [::url]))
+
+(s/def ::action-opts
+ (s/multi-spec action-opts-spec ::action-type))
+
+;; -- Interaction
+
+(s/def ::classifier
+ (s/keys :req-un [::event-type
+ ::action-type]))
+
+(s/def ::interaction
+ (s/merge ::classifier
+ ::event-opts
+ ::action-opts))
+
+(s/def ::interactions
+ (s/coll-of ::interaction :kind vector?))
+
+(def default-interaction
+ {:event-type :click
+ :action-type :navigate
+ :destination nil})
+
+(def default-delay 600)
+
+;; -- Helpers for interaction
+
+(declare calc-overlay-pos-initial)
+
+(defn set-event-type
+ [interaction event-type shape]
+ (us/verify ::interaction interaction)
+ (us/verify ::event-type event-type)
+ (assert (or (not= event-type :after-delay)
+ (= (:type shape) :frame)))
+ (if (= (:event-type interaction) event-type)
+ interaction
+ (case event-type
+
+ :after-delay
+ (assoc interaction
+ :event-type event-type
+ :delay (get interaction :delay default-delay))
+
+ (assoc interaction
+ :event-type event-type))))
+
+
+(defn set-action-type
+ [interaction action-type]
+ (us/verify ::interaction interaction)
+ (us/verify ::action-type action-type)
+ (if (= (:action-type interaction) action-type)
+ interaction
+ (case action-type
+
+ :navigate
+ (assoc interaction
+ :action-type action-type
+ :destination (get interaction :destination))
+
+ (:open-overlay :toggle-overlay)
+ (let [overlay-pos-type (get interaction :overlay-pos-type :center)
+ overlay-position (get interaction :overlay-position (gpt/point 0 0))]
+ (assoc interaction
+ :action-type action-type
+ :overlay-pos-type overlay-pos-type
+ :overlay-position overlay-position))
+
+ :close-overlay
+ (assoc interaction
+ :action-type action-type
+ :destination (get interaction :destination))
+
+ :prev-screen
+ (assoc interaction
+ :action-type action-type)
+
+ :open-url
+ (assoc interaction
+ :action-type action-type
+ :url (get interaction :url "")))))
+
+(defn has-delay
+ [interaction]
+ (= (:event-type interaction) :after-delay))
+
+(defn set-delay
+ [interaction delay]
+ (us/verify ::interaction interaction)
+ (us/verify ::delay delay)
+ (assert (has-delay interaction))
+ (assoc interaction :delay delay))
+
+(defn has-destination
+ [interaction]
+ (#{:navigate :open-overlay :toggle-overlay :close-overlay}
+ (:action-type interaction)))
+
+(defn destination?
+ [interaction]
+ (and (has-destination interaction)
+ (some? (:destination interaction))))
+
+(defn set-destination
+ [interaction destination]
+ (us/verify ::interaction interaction)
+ (us/verify ::destination destination)
+ (assert (has-destination interaction))
+ (cond-> interaction
+ :always
+ (assoc :destination destination)
+
+ (or (= (:action-type interaction) :open-overlay)
+ (= (:action-type interaction) :toggle-overlay))
+ (assoc :overlay-pos-type :center
+ :overlay-position (gpt/point 0 0))))
+
+(defn has-url
+ [interaction]
+ (= (:action-type interaction) :open-url))
+
+(defn set-url
+ [interaction url]
+ (us/verify ::interaction interaction)
+ (us/verify ::url url)
+ (assert (has-url interaction))
+ (assoc interaction :url url))
+
+(defn has-overlay-opts
+ [interaction]
+ (#{:open-overlay :toggle-overlay} (:action-type interaction)))
+
+(defn set-overlay-pos-type
+ [interaction overlay-pos-type shape objects]
+ (us/verify ::interaction interaction)
+ (us/verify ::overlay-pos-type overlay-pos-type)
+ (assert (has-overlay-opts interaction))
+ (assoc interaction
+ :overlay-pos-type overlay-pos-type
+ :overlay-position (calc-overlay-pos-initial (:destination interaction)
+ shape
+ objects
+ overlay-pos-type)))
+(defn toggle-overlay-pos-type
+ [interaction overlay-pos-type shape objects]
+ (us/verify ::interaction interaction)
+ (us/verify ::overlay-pos-type overlay-pos-type)
+ (assert (has-overlay-opts interaction))
+ (let [new-pos-type (if (= (:overlay-pos-type interaction) overlay-pos-type)
+ :manual
+ overlay-pos-type)]
+ (assoc interaction
+ :overlay-pos-type new-pos-type
+ :overlay-position (calc-overlay-pos-initial (:destination interaction)
+ shape
+ objects
+ new-pos-type))))
+(defn set-overlay-position
+ [interaction overlay-position]
+ (us/verify ::interaction interaction)
+ (us/verify ::overlay-position overlay-position)
+ (assert (has-overlay-opts interaction))
+ (assoc interaction
+ :overlay-pos-type :manual
+ :overlay-position overlay-position))
+
+(defn set-close-click-outside
+ [interaction close-click-outside]
+ (us/verify ::interaction interaction)
+ (us/verify ::us/boolean close-click-outside)
+ (assert (has-overlay-opts interaction))
+ (assoc interaction :close-click-outside close-click-outside))
+
+(defn set-background-overlay
+ [interaction background-overlay]
+ (us/verify ::interaction interaction)
+ (us/verify ::us/boolean background-overlay)
+ (assert (has-overlay-opts interaction))
+ (assoc interaction :background-overlay background-overlay))
+
+(defn- calc-overlay-pos-initial
+ [destination shape objects overlay-pos-type]
+ (if (= overlay-pos-type :manual)
+ (let [dest-frame (get objects destination)
+ overlay-size (:selrect dest-frame)
+ orig-frame (if (= (:type shape) :frame)
+ shape
+ (get objects (:frame-id shape)))
+ frame-size (:selrect orig-frame)]
+ (gpt/point (/ (- (:width frame-size) (:width overlay-size)) 2)
+ (/ (- (:height frame-size) (:height overlay-size)) 2)))
+ (gpt/point 0 0)))
+
+(defn calc-overlay-position
+ [interaction base-frame dest-frame frame-offset]
+ (us/verify ::interaction interaction)
+ (assert (has-overlay-opts interaction))
+ (if (nil? dest-frame)
+ (gpt/point 0 0)
+ (let [overlay-size (:selrect dest-frame)
+ base-frame-size (:selrect base-frame)]
+ (case (:overlay-pos-type interaction)
+ :center
+ (gpt/point (/ (- (:width base-frame-size) (:width overlay-size)) 2)
+ (/ (- (:height base-frame-size) (:height overlay-size)) 2))
+
+ :top-left
+ (gpt/point 0 0)
+
+ :top-right
+ (gpt/point (- (:width base-frame-size) (:width overlay-size))
+ 0)
+
+ :top-center
+ (gpt/point (/ (- (:width base-frame-size) (:width overlay-size)) 2)
+ 0)
+
+ :bottom-left
+ (gpt/point 0
+ (- (:height base-frame-size) (:height overlay-size)))
+
+ :bottom-right
+ (gpt/point (- (:width base-frame-size) (:width overlay-size))
+ (- (:height base-frame-size) (:height overlay-size)))
+
+ :bottom-center
+ (gpt/point (/ (- (:width base-frame-size) (:width overlay-size)) 2)
+ (- (:height base-frame-size) (:height overlay-size)))
+
+ :manual
+ (gpt/add (:overlay-position interaction) frame-offset)))))
+
+;; -- Helpers for interactions
+
+(defn add-interaction
+ [interactions interaction]
+ (conj (or interactions []) interaction))
+
+(defn remove-interaction
+ [interactions index]
+ (let [interactions (or interactions [])]
+ (into (subvec interactions 0 index)
+ (subvec interactions (inc index)))))
+
+(defn update-interaction
+ [interactions index update-fn]
+ (update interactions index update-fn))
+
+(defn remap-interactions
+ "Update all interactions whose destination points to a shape in the
+ map to the new id. And remove the ones whose destination does not exist
+ in the map nor in the objects tree."
+ [interactions ids-map objects]
+ (when (some? interactions)
+ (let [xform (comp (filter (fn [interaction]
+ (let [destination (:destination interaction)]
+ (or (nil? destination)
+ (contains? ids-map destination)
+ (contains? objects destination)))))
+ (map (fn [interaction]
+ (d/update-when interaction :destination #(get ids-map % %)))))]
+ (into [] xform interactions))))
+
+(defn actionable?
+ "Check if there is any interaction that is clickable by the user"
+ [interactions]
+ (some #(= (:event-type %) :click) interactions))
+
+(defn flow-origin?
+ "Check if there is any interaction that is the start or the continuation of a flow"
+ [interactions]
+ (some #(and (#{:navigate :open-overlay :toggle-overlay :close-overlay} (:action-type %))
+ (some? (:destination %)))
+ interactions))
+
+(defn flow-to?
+ "Check if there is any interaction that flows into the given frame"
+ [interactions frame-id]
+ (some #(and (#{:navigate :open-overlay :toggle-overlay :close-overlay} (:action-type %))
+ (= (:destination %) frame-id))
+ interactions))
diff --git a/common/src/app/common/types/page_options.cljc b/common/src/app/common/types/page_options.cljc
new file mode 100644
index 000000000..c15258eda
--- /dev/null
+++ b/common/src/app/common/types/page_options.cljc
@@ -0,0 +1,94 @@
+;; 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.common.types.page-options
+ (:require
+ [app.common.data :as d]
+ [app.common.spec :as us]
+ [clojure.spec.alpha :as s]))
+
+;; --- Grid options
+
+(s/def :artboard-grid.color/color ::us/string)
+(s/def :artboard-grid.color/opacity ::us/safe-number)
+
+(s/def :artboard-grid/size ::us/safe-integer)
+(s/def :artboard-grid/color (s/keys :req-un [:artboard-grid.color/color
+ :artboard-grid.color/opacity]))
+(s/def :artboard-grid/type #{:stretch :left :center :right})
+(s/def :artboard-grid/item-length (s/nilable ::us/safe-integer))
+(s/def :artboard-grid/gutter (s/nilable ::us/safe-integer))
+(s/def :artboard-grid/margin (s/nilable ::us/safe-integer))
+
+(s/def :artboard-grid/square
+ (s/keys :req-un [:artboard-grid/size
+ :artboard-grid/color]))
+
+(s/def :artboard-grid/column
+ (s/keys :req-un [:artboard-grid/size
+ :artboard-grid/color
+ :artboard-grid/margin
+ :artboard-grid/gutter]
+ :opt-un [:artboard-grid/type
+ :artboard-grid/item-length]))
+
+(s/def :artboard-grid/row :artboard-grid/column)
+
+(s/def ::saved-grids
+ (s/keys :opt-un [:artboard-grid/square
+ :artboard-grid/row
+ :artboard-grid/column]))
+
+;; --- Background options
+
+(s/def ::background string?)
+
+;; --- Flow options
+
+(s/def :interactions-flow/id ::us/uuid)
+(s/def :interactions-flow/name ::us/string)
+(s/def :interactions-flow/starting-frame ::us/uuid)
+
+(s/def ::flow
+ (s/keys :req-un [:interactions-flow/id
+ :interactions-flow/name
+ :interactions-flow/starting-frame]))
+
+(s/def ::flows
+ (s/coll-of ::flow :kind vector?))
+
+;; --- Options
+
+(s/def ::options
+ (s/keys :opt-un [::background
+ ::saved-grids
+ ::flows]))
+
+;; --- Helpers for flow
+
+(defn rename-flow
+ [flow name]
+ (assoc flow :name name))
+
+;; --- Helpers for flows
+
+(defn add-flow
+ [flows flow]
+ (conj (or flows []) flow))
+
+(defn remove-flow
+ [flows flow-id]
+ (d/removev #(= (:id %) flow-id) flows))
+
+(defn update-flow
+ [flows flow-id update-fn]
+ (let [index (d/index-of-pred flows #(= (:id %) flow-id))]
+ (update flows index update-fn)))
+
+(defn get-frame-flow
+ [flows frame-id]
+ (d/seek #(= (:starting-frame %) frame-id) flows))
+
diff --git a/docker/devenv/Dockerfile b/docker/devenv/Dockerfile
index bdfbd3341..6b8290e3a 100644
--- a/docker/devenv/Dockerfile
+++ b/docker/devenv/Dockerfile
@@ -3,10 +3,10 @@ LABEL maintainer="Andrey Antukh " (:explain data) "\n")} + {:status 400 + :headers {"content-type" "text/html"} + :body (str "
" (:explain data) "\n")})) + + (and (= :internal type) + (= :browser-not-ready code)) + {:status 503 + :headers {"x-error" (t/encode data)} + :body ""} + + :else + (do + (log/error :msg "Unexpected error" :error error) + (js/console.error error) + {:status 500 + :headers {"x-error" (t/encode data)} + :body ""})))) + (defn init [] (let [router (r/router routes) - handler (impl/handler router) - server (impl/server handler) + handler (impl/router-handler router) + server (impl/server handler on-error) port (cf/get :http-server-port 6061)] (.listen server port) + (log/info :msg "welcome to penpot" + :module "exporter" + :version (:full @cf/version)) (log/info :msg "starting http server" :port port) (reset! instance server))) diff --git a/exporter/src/app/http/impl.cljs b/exporter/src/app/http/impl.cljs index 3401194d4..67d54f6d8 100644 --- a/exporter/src/app/http/impl.cljs +++ b/exporter/src/app/http/impl.cljs @@ -7,8 +7,8 @@ (ns app.http.impl (:require ["http" :as http] + ["cookies" :as Cookies] ["inflation" :as inflate] - ["koa" :as koa] ["raw-body" :as raw-body] [app.util.transit :as t] [cuerdas.core :as str] @@ -17,94 +17,66 @@ [promesa.core :as p] [reitit.core :as r])) +(def methods-with-body + #{"POST" "PUT" "DELETE"}) + (defn- match - [router ctx] - (let [uri (u/uri (unchecked-get ctx "originalUrl"))] - (when-let [match (r/match-by-path router (:path uri))] - (assoc match :query-params (u/query-string->map (:query uri)))))) - -(defn- handle-error - [error request] - (let [{:keys [type message code] :as data} (ex-data error)] - (cond - (= :validation type) - (let [header (get-in request [:headers "accept"])] - (if (and (str/starts-with? header "text/html") - (= :spec-validation (:code data))) - {:status 400 - :headers {"content-type" "text/html"} - :body (str "
" (:explain data) "\n")} - {:status 400 - :headers {"content-type" "text/html"} - :body (str "
" (:explain data) "\n")})) - - (and (= :internal type) - (= :browser-not-ready code)) - {:status 503 - :headers {"x-error" (t/encode data)} - :body ""} - - :else - (do - (log/error :msg "Unexpected error" - :error error) - (js/console.error error) - {:status 500 - :headers {"x-error" (t/encode data)} - :body ""})))) + [router {:keys [path query] :as request}] + (when-let [match (r/match-by-path router path)] + (assoc match :query-params (u/query-string->map query)))) (defn- handle-response - [ctx {:keys [body headers status] :or {headers {} status 200}}] - (run! (fn [[k v]] (.set ^js ctx k v)) headers) - (set! (.-body ^js ctx) body) - (set! (.-status ^js ctx) status) - nil) + [req res] + (fn [{:keys [body headers status] :or {headers {} status 200}}] + (.writeHead ^js res status (clj->js headers)) + (.end ^js res body))) (defn- parse-headers - [ctx] - (let [orig (unchecked-get ctx "headers")] + [req] + (let [orig (unchecked-get req "headers")] (persistent! (reduce #(assoc! %1 %2 (unchecked-get orig %2)) (transient {}) (js/Object.keys orig))))) -(def parse-body? #{"POST" "PUT" "DELETE"}) - (defn- parse-body - [ctx] - (let [headers (unchecked-get ctx "headers") - ctype (unchecked-get headers "content-type")] - (when (parse-body? (.-method ^js ctx)) - (-> (inflate (.-req ^js ctx)) - (raw-body #js {:limit "5mb" :encoding "utf8"}) + [req] + (let [headers (unchecked-get req "headers") + method (unchecked-get req "method") + ctype (unchecked-get headers "content-type") + opts #js {:limit "5mb" :encoding "utf8"}] + (when (contains? methods-with-body method) + (-> (raw-body (inflate req) opts) (p/then (fn [data] - (cond-> data - (= ctype "application/transit+json") - (t/decode)))))))) + (cond-> data + (= ctype "application/transit+json") + (t/decode)))))))) -(defn- wrap-handler - [f] - (fn [ctx] - (p/let [cookies (unchecked-get ctx "cookies") - headers (parse-headers ctx) - body (parse-body ctx) - request {:method (str/lower (unchecked-get ctx "method")) - :body body - :ctx ctx - :headers headers - :cookies cookies}] - (-> (p/do! (f request)) - (p/then (fn [rsp] - (when (map? rsp) - (handle-response ctx rsp)))) - (p/catch (fn [err] - (->> (handle-error err request) - (handle-response ctx)))))))) +(defn- handler-adapter + [handler on-error] + (fn [req res] + (let [cookies (new Cookies req res) + headers (parse-headers req) + uri (u/uri (unchecked-get req "url")) + request {:method (str/lower (unchecked-get req "method")) + :path (:path uri) + :query (:query uri) + :url uri + :headers headers + :cookies cookies + :internal-request req + :internal-response res}] + (-> (parse-body req) + (p/then (fn [body] + (let [request (assoc request :body body)] + (handler request)))) + (p/catch (fn [error] (on-error error request))) + (p/then (handle-response req res)))))) -(defn- router-handler +(defn router-handler [router] - (fn [{:keys [ctx body] :as request}] - (let [route (match router ctx) + (fn [{:keys [body] :as request}] + (let [route (match router request) params (merge {} (:query-params route) (:path-params route) @@ -120,16 +92,5 @@ :body "Not found"})))) (defn server - [handler] - (.createServer http @handler)) - -(defn handler - [router] - (let [instance (doto (new koa) - (.use (-> (router-handler router) - (wrap-handler))))] - (specify! instance - cljs.core/IDeref - (-deref [_] - (.callback instance))))) - + [handler on-error] + (.createServer ^js http (handler-adapter handler on-error))) diff --git a/exporter/src/app/renderer/svg.cljs b/exporter/src/app/renderer/svg.cljs index 93e0649f4..54544aa24 100644 --- a/exporter/src/app/renderer/svg.cljs +++ b/exporter/src/app/renderer/svg.cljs @@ -210,11 +210,10 @@ :height (.. attrs -height -value) :colors (.split colors ",")})) - (extract-single-node [node] + (extract-single-node [[shot node]] (log/trace :fn :extract-single-node) - (p/let [attrs (bw/eval! node extract-element-attrs) - shot (bw/screenshot node {:omit-background? true :type "png"})] + (p/let [attrs (bw/eval! node extract-element-attrs)] {:id (unchecked-get attrs "id") :x (unchecked-get attrs "x") :y (unchecked-get attrs "y") @@ -223,13 +222,21 @@ :colors (vec (unchecked-get attrs "colors")) :data shot})) + (resolve-text-node [page node] + (p/let [attrs (bw/eval! node extract-element-attrs) + id (unchecked-get attrs "id") + text-node (bw/select page (str "#screenshot-text-" id " foreignObject")) + shot (bw/screenshot text-node {:omit-background? true :type "png"})] + [shot node])) + (clean-temp-data [{:keys [tempdir] :as node}] (p/do! (sh/rmdir! tempdir) (dissoc node :tempdir))) - (process-text-node [item] + (process-text-node [page item] (-> (p/resolved item) + (p/then (partial resolve-text-node page)) (p/then extract-single-node) (p/then trace-node) (p/then clean-temp-data))) @@ -237,7 +244,7 @@ (process-text-nodes [page] (log/trace :fn :process-text-nodes) (-> (bw/select-all page "#screenshot foreignObject") - (p/then (fn [nodes] (p/all (map process-text-node nodes)))))) + (p/then (fn [nodes] (p/all (map (partial process-text-node page) nodes)))))) (extract-svg [page] (p/let [dom (bw/select page "#screenshot") @@ -271,7 +278,7 @@ (p/let [page (render-in-page page rctx)] (extract-svg page)))] - (let [path (str "/render-object/" file-id "/" page-id "/" object-id) + (let [path (str "/render-object/" file-id "/" page-id "/" object-id "?render-texts=true") uri (-> (u/uri (cf/get :public-uri)) (assoc :path "/") (assoc :fragment path)) diff --git a/exporter/src/app/sentry.cljs b/exporter/src/app/sentry.cljs new file mode 100644 index 000000000..4f7c9be5c --- /dev/null +++ b/exporter/src/app/sentry.cljs @@ -0,0 +1,44 @@ +;; 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.sentry + (:require + ["@sentry/node" :as sentry] + ["@sentry/tracing" :as sentry-t] + [app.common.data :as d] + [app.config :as cf])) + +(defn init! + [] + (when-let [dsn (cf/get :sentry-dsn)] + (sentry/init + #js {:dsn dsn + :release (str "frontend@" (:base @cf/version)) + :serverName (cf/get :host) + :environment (cf/get :tenant) + :autoSessionTracking false + :attachStacktrace false + :maxBreadcrumbs 20 + :tracesSampleRate 1.0}))) + +(def parse-request (unchecked-get sentry/Handlers "parseRequest")) + +(defn capture-exception + [error {:keys [::request ::tags] :as context}] + (let [context (-> (dissoc context ::request ::tags) + (d/without-nils))] + (sentry/withScope + (fn [scope] + (.addEventProcessor ^js scope (fn [event] + (let [node-request (:internal-request request)] + (parse-request event node-request)))) + (doseq [[k v] tags] + (.setTag ^js scope (if (keyword? k) (name k) (str k)) (str v))) + + (doseq [[k v] context] + (.setContext ^js scope (if (keyword? k) (name k) (str k)) (clj->js v))) + + (sentry/captureException error))))) diff --git a/exporter/yarn.lock b/exporter/yarn.lock index 62e1b751b..a671fedf5 100644 --- a/exporter/yarn.lock +++ b/exporter/yarn.lock @@ -10,6 +10,74 @@ core-js-pure "^3.16.0" regenerator-runtime "^0.13.4" +"@sentry/core@6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/core/-/core-6.13.1.tgz#158cb7391c1aed4083fe12f40a3aecc951e3d354" + integrity sha512-IGitAHYtsDPhPPcSTDqL/NMOwTbrqPezQOo4rlU1p1lpyZKSKrgzn/8LCrb+eRV2ffaio6+3kwqjCN2SvU8S7A== + dependencies: + "@sentry/hub" "6.13.1" + "@sentry/minimal" "6.13.1" + "@sentry/types" "6.13.1" + "@sentry/utils" "6.13.1" + tslib "^1.9.3" + +"@sentry/hub@6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/hub/-/hub-6.13.1.tgz#587227fa502e3ed699878ac903f2a5100849cb00" + integrity sha512-O7bR5suyVNTNyr6tm0IjhZ7NvxSHIbHoy5KYbVv05HQ/DmvAbYWq4dtOMvYQuuTD9krGkZdwPg4Gm6KnFaKqoQ== + dependencies: + "@sentry/types" "6.13.1" + "@sentry/utils" "6.13.1" + tslib "^1.9.3" + +"@sentry/minimal@6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/minimal/-/minimal-6.13.1.tgz#86865cc0d6090d9c8be2c44ec7f14a9c66910e7d" + integrity sha512-waRLPRFT1G95LsklH25LvfJy4vSe54PPRSeAGNPa4xVLCP56CnbNXGEXGDyPUewtqESwVpRG6GPL1QRV67IixA== + dependencies: + "@sentry/hub" "6.13.1" + "@sentry/types" "6.13.1" + tslib "^1.9.3" + +"@sentry/node@^6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/node/-/node-6.13.1.tgz#9b76d5746a6e851a11bcdc25097177cbb28fcc82" + integrity sha512-uSAsRPGeTNb6pEzHQ4/RkaylO95f6SmS1yzMizlMkgZq5qPDkmKgN+sZ04g58XlZ6nDKTxYoLSZsfxdaIZNTcw== + dependencies: + "@sentry/core" "6.13.1" + "@sentry/hub" "6.13.1" + "@sentry/tracing" "6.13.1" + "@sentry/types" "6.13.1" + "@sentry/utils" "6.13.1" + cookie "^0.4.1" + https-proxy-agent "^5.0.0" + lru_map "^0.3.3" + tslib "^1.9.3" + +"@sentry/tracing@6.13.1", "@sentry/tracing@^6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/tracing/-/tracing-6.13.1.tgz#eec84740a2566132c14c151e855f2a8a2dac3716" + integrity sha512-UF0yHtWXi5SfDa5oKCSw463P3AyAf635w6zFMiLV6kt8DDjnOwJRcT7dekRIU8F4Du+2nWJFPoXsmt1sablycw== + dependencies: + "@sentry/hub" "6.13.1" + "@sentry/minimal" "6.13.1" + "@sentry/types" "6.13.1" + "@sentry/utils" "6.13.1" + tslib "^1.9.3" + +"@sentry/types@6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/types/-/types-6.13.1.tgz#650e5e5fe4aa415987e14cfa2ca03e5d5eb3e347" + integrity sha512-dYm8qv/O6QhOCmWi5rlJBX9rjEqvnjnZH1zqhQCWhMmF9aYS151Y41P1C0TS0o17Z0ClonLiYMG1J+zE/Pmtqg== + +"@sentry/utils@6.13.1": + version "6.13.1" + resolved "https://registry.yarnpkg.com/@sentry/utils/-/utils-6.13.1.tgz#5c974c4235615ac50caed2b25c30b33a6a234425" + integrity sha512-qFDup/nBj2u2rAcQADFG3njVYUCo4XOQkCT7XdA5Flg1a++r6tIBdjiRyyjb8nqwHZ/OQsKr/V/EQaJiW29ETA== + dependencies: + "@sentry/types" "6.13.1" + tslib "^1.9.3" + "@types/node@*": version "16.6.2" resolved "https://registry.yarnpkg.com/@types/node/-/node-16.6.2.tgz#331b7b9f8621c638284787c5559423822fdffc50" @@ -22,14 +90,6 @@ dependencies: "@types/node" "*" -accepts@^1.3.5: - version "1.3.7" - resolved "https://registry.yarnpkg.com/accepts/-/accepts-1.3.7.tgz#531bc726517a3b2b41f850021c6cc15eaab507cd" - integrity sha512-Il80Qs2WjYlJIBNzNkK6KYqlVMTbZLXgHx2oT0pU/fjRHyEp+PEfEPY0R3WCwAGVOtauxh1hOxNgIf5bv7dQpA== - dependencies: - mime-types "~2.1.24" - negotiator "0.6.2" - agent-base@6: version "6.0.2" resolved "https://registry.yarnpkg.com/agent-base/-/agent-base-6.0.2.tgz#49fff58577cfee3f37176feab4c22e00f86d7f77" @@ -37,11 +97,6 @@ agent-base@6: dependencies: debug "4" -any-promise@^1.1.0: - version "1.3.0" - resolved "https://registry.yarnpkg.com/any-promise/-/any-promise-1.3.0.tgz#abc6afeedcea52e809cdc0376aed3ce39635d17f" - integrity sha1-q8av7tzqUugJzcA3au0845Y10X8= - asn1.js@^5.2.0: version "5.4.1" resolved "https://registry.yarnpkg.com/asn1.js/-/asn1.js-5.4.1.tgz#11a980b84ebb91781ce35b0fdc2ee294e3783f07" @@ -205,14 +260,6 @@ bytes@3.1.0: resolved "https://registry.yarnpkg.com/bytes/-/bytes-3.1.0.tgz#f6cf7933a360e0588fa9fde85651cdc7f805d1f6" integrity sha512-zauLjrfCG+xvoyaqLoV8bLVXXNGC4JqlxFCutSDWA6fJrTo2ZuvLYTqZ7aHBLZSMOopbzwv8f+wZcVzfVTI2Dg== -cache-content-type@^1.0.0: - version "1.0.1" - resolved "https://registry.yarnpkg.com/cache-content-type/-/cache-content-type-1.0.1.tgz#035cde2b08ee2129f4a8315ea8f00a00dba1453c" - integrity sha512-IKufZ1o4Ut42YUrZSo8+qnMTrFuKkvyoLXUywKz9GJ5BrhOFGhLdkx9sG4KAnVvbY6kEcSFjLQul+DVmBm2bgA== - dependencies: - mime-types "^2.1.18" - ylru "^1.2.0" - chownr@^1.1.1: version "1.1.4" resolved "https://registry.yarnpkg.com/chownr/-/chownr-1.1.4.tgz#6fc9d7b42d32a583596337666e7d08084da2cc6b" @@ -226,11 +273,6 @@ cipher-base@^1.0.0, cipher-base@^1.0.1, cipher-base@^1.0.3: inherits "^2.0.1" safe-buffer "^5.0.1" -co@^4.6.0: - version "4.6.0" - resolved "https://registry.yarnpkg.com/co/-/co-4.6.0.tgz#6ea6bdf3d853ae54ccb8e47bfa0bf3f9031fb184" - integrity sha1-bqa989hTrlTMuOR7+gvz+QMfsYQ= - concat-map@0.0.1: version "0.0.1" resolved "https://registry.yarnpkg.com/concat-map/-/concat-map-0.0.1.tgz#d8a96bd77fd68df7793a73036a3ba0d5405d477b" @@ -246,19 +288,12 @@ constants-browserify@^1.0.0: resolved "https://registry.yarnpkg.com/constants-browserify/-/constants-browserify-1.0.0.tgz#c20b96d8c617748aaf1c16021760cd27fcb8cb75" integrity sha1-wguW2MYXdIqvHBYCF2DNJ/y4y3U= -content-disposition@~0.5.2: - version "0.5.3" - resolved "https://registry.yarnpkg.com/content-disposition/-/content-disposition-0.5.3.tgz#e130caf7e7279087c5616c2007d0485698984fbd" - integrity sha512-ExO0774ikEObIAEV9kDo50o+79VCUdEB6n6lzKgGwupcVeRlhrj3qGAfwq8G6uBJjkqLrhT0qEYFcWng8z1z0g== - dependencies: - safe-buffer "5.1.2" +cookie@^0.4.1: + version "0.4.1" + resolved "https://registry.yarnpkg.com/cookie/-/cookie-0.4.1.tgz#afd713fe26ebd21ba95ceb61f9a8116e50a537d1" + integrity sha512-ZwrFkGJxUR3EIoXtO+yVE69Eb7KlixbaeAWfBQB9vVsNn/o+Yw69gBWSSDK825hQNdN+wF8zELf3dFNl/kxkUA== -content-type@^1.0.4: - version "1.0.4" - resolved "https://registry.yarnpkg.com/content-type/-/content-type-1.0.4.tgz#e138cc75e040c727b1966fe5e5f8c9aee256fe3b" - integrity sha512-hIP3EEPs8tB9AT1L+NUqtwOAps4mk2Zob89MWXMHjHWg9milF/j4osnnQLXBCBFBk/tvIG/tUc9mOUJiPBhPXA== - -cookies@~0.8.0: +cookies@^0.8.0: version "0.8.0" resolved "https://registry.yarnpkg.com/cookies/-/cookies-0.8.0.tgz#1293ce4b391740a8406e3c9870e828c4b54f3f90" integrity sha512-8aPsApQfebXnuI+537McwYsDtjVxGm8gTIzQI3FDW6t5t/DAhERxtnbEPN/8RX+uZthoz4eCOgloXaE5cYyNow== @@ -338,33 +373,16 @@ debug@4.3.1: dependencies: ms "2.1.2" -debug@~3.1.0: - version "3.1.0" - resolved "https://registry.yarnpkg.com/debug/-/debug-3.1.0.tgz#5bb5a0672628b64149566ba16819e61518c67261" - integrity sha512-OX8XqP7/1a9cqkxYw2yXss15f26NKWBpDXQd0/uK/KPqdQhxbPa994hnzjcE2VqQpDslf55723cKPUOGSmMY3g== - dependencies: - ms "2.0.0" - -deep-equal@~1.0.1: - version "1.0.1" - resolved "https://registry.yarnpkg.com/deep-equal/-/deep-equal-1.0.1.tgz#f5d260292b660e084eff4cdbc9f08ad3247448b5" - integrity sha1-9dJgKStmDghO/0zbyfCK0yR0SLU= - -delegates@^1.0.0: - version "1.0.0" - resolved "https://registry.yarnpkg.com/delegates/-/delegates-1.0.0.tgz#84c6e159b81904fdca59a0ef44cd870d31250f9a" - integrity sha1-hMbhWbgZBP3KWaDvRM2HDTElD5o= - -depd@^2.0.0, depd@~2.0.0: - version "2.0.0" - resolved "https://registry.yarnpkg.com/depd/-/depd-2.0.0.tgz#b696163cc757560d09cf22cc8fad1571b79e76df" - integrity sha512-g7nH6P6dyDioJogAAGprGpCtVImJhpPk/roCzdb3fIh61/s/nPsfR6onyMwkCAR/OlC3yBC0lESvUoQEAssIrw== - depd@~1.1.2: version "1.1.2" resolved "https://registry.yarnpkg.com/depd/-/depd-1.1.2.tgz#9bcd52e14c097763e749b274c4346ed2e560b5a9" integrity sha1-m81S4UwJd2PnSbJ0xDRu0uVgtak= +depd@~2.0.0: + version "2.0.0" + resolved "https://registry.yarnpkg.com/depd/-/depd-2.0.0.tgz#b696163cc757560d09cf22cc8fad1571b79e76df" + integrity sha512-g7nH6P6dyDioJogAAGprGpCtVImJhpPk/roCzdb3fIh61/s/nPsfR6onyMwkCAR/OlC3yBC0lESvUoQEAssIrw== + des.js@^1.0.0: version "1.0.1" resolved "https://registry.yarnpkg.com/des.js/-/des.js-1.0.1.tgz#5382142e1bdc53f85d86d53e5f4aa7deb91e0843" @@ -373,11 +391,6 @@ des.js@^1.0.0: inherits "^2.0.1" minimalistic-assert "^1.0.0" -destroy@^1.0.4: - version "1.0.4" - resolved "https://registry.yarnpkg.com/destroy/-/destroy-1.0.4.tgz#978857442c44749e4206613e37946205826abd80" - integrity sha1-l4hXRCxEdJ5CBmE+N5RiBYJqvYA= - devtools-protocol@0.0.901419: version "0.0.901419" resolved "https://registry.yarnpkg.com/devtools-protocol/-/devtools-protocol-0.0.901419.tgz#79b5459c48fe7e1c5563c02bd72f8fec3e0cebcd" @@ -397,11 +410,6 @@ domain-browser@^1.1.1: resolved "https://registry.yarnpkg.com/domain-browser/-/domain-browser-1.2.0.tgz#3d31f50191a6749dd1375a7f522e823d42e54eda" integrity sha512-jnjyiM6eRyZl2H+W8Q/zLMA481hzi0eszAaBUzIVnmYVDBbnLxVNnfu1HgEBvCbL+71FrxMl3E6lpKH7Ge3OXA== -ee-first@1.1.1: - version "1.1.1" - resolved "https://registry.yarnpkg.com/ee-first/-/ee-first-1.1.1.tgz#590c61156b0ae2f4f0255732a158b266bc56b21d" - integrity sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0= - elliptic@^6.5.3: version "6.5.4" resolved "https://registry.yarnpkg.com/elliptic/-/elliptic-6.5.4.tgz#da37cebd31e79a1367e941b592ed1fbebd58abbb" @@ -415,11 +423,6 @@ elliptic@^6.5.3: minimalistic-assert "^1.0.1" minimalistic-crypto-utils "^1.0.1" -encodeurl@^1.0.2: - version "1.0.2" - resolved "https://registry.yarnpkg.com/encodeurl/-/encodeurl-1.0.2.tgz#ad3ff4c86ec2d029322f5a02c3a9a606c95b3f59" - integrity sha1-rT/0yG7C0CkyL1oCw6mmBslbP1k= - end-of-stream@^1.1.0, end-of-stream@^1.4.1: version "1.4.4" resolved "https://registry.yarnpkg.com/end-of-stream/-/end-of-stream-1.4.4.tgz#5ae64a5f45057baf3626ec14da0ca5e4b2431eb0" @@ -427,11 +430,6 @@ end-of-stream@^1.1.0, end-of-stream@^1.4.1: dependencies: once "^1.4.0" -escape-html@^1.0.3: - version "1.0.3" - resolved "https://registry.yarnpkg.com/escape-html/-/escape-html-1.0.3.tgz#0258eae4d3d0c0974de1c169188ef0051d1d1988" - integrity sha1-Aljq5NPQwJdN4cFpGI7wBR0dGYg= - events@^3.0.0: version "3.3.0" resolved "https://registry.yarnpkg.com/events/-/events-3.3.0.tgz#31a95ad0a924e2d2c419a813aeb2c4e878ea7400" @@ -471,11 +469,6 @@ find-up@^4.0.0: locate-path "^5.0.0" path-exists "^4.0.0" -fresh@~0.5.2: - version "0.5.2" - resolved "https://registry.yarnpkg.com/fresh/-/fresh-0.5.2.tgz#3d8cadd90d976569fa835ab1f8e4b23a105605a7" - integrity sha1-PYyt2Q2XZWn6g1qx+OSyOhBWBac= - fs-constants@^1.0.0: version "1.0.0" resolved "https://registry.yarnpkg.com/fs-constants/-/fs-constants-1.0.0.tgz#6be0de9be998ce16af8afc24497b9ee9b7ccd9ad" @@ -510,18 +503,6 @@ glob@^7.1.3: once "^1.3.0" path-is-absolute "^1.0.0" -has-symbols@^1.0.2: - version "1.0.2" - resolved "https://registry.yarnpkg.com/has-symbols/-/has-symbols-1.0.2.tgz#165d3070c00309752a1236a479331e3ac56f1423" - integrity sha512-chXa79rL/UC2KlX17jo3vRGz0azaWEx5tGqZg5pO3NUyEJVB17dMruQlzCCOfUvElghKcm5194+BCRvi2Rv/Gw== - -has-tostringtag@^1.0.0: - version "1.0.0" - resolved "https://registry.yarnpkg.com/has-tostringtag/-/has-tostringtag-1.0.0.tgz#7e133818a7d394734f941e73c3d3f9291e658b25" - integrity sha512-kFjcSNhnlGV1kyoGk7OXKSawH5JOb/LzUc5w9B02hOTO0dfFRjbHQKvg1d6cf3HbeUmtU9VbbV3qzZ2Teh97WQ== - dependencies: - has-symbols "^1.0.2" - hash-base@^3.0.0: version "3.1.0" resolved "https://registry.yarnpkg.com/hash-base/-/hash-base-3.1.0.tgz#55c381d9e06e1d2997a883b4a3fddfe7f0d3af33" @@ -548,15 +529,7 @@ hmac-drbg@^1.0.1: minimalistic-assert "^1.0.0" minimalistic-crypto-utils "^1.0.1" -http-assert@^1.3.0: - version "1.4.1" - resolved "https://registry.yarnpkg.com/http-assert/-/http-assert-1.4.1.tgz#c5f725d677aa7e873ef736199b89686cceb37878" - integrity sha512-rdw7q6GTlibqVVbXr0CKelfV5iY8G2HqEUkhSk297BMbSpSL8crXC+9rjKoMcZZEsksX30le6f/4ul4E28gegw== - dependencies: - deep-equal "~1.0.1" - http-errors "~1.7.2" - -http-errors@1.7.3, http-errors@~1.7.2: +http-errors@1.7.3: version "1.7.3" resolved "https://registry.yarnpkg.com/http-errors/-/http-errors-1.7.3.tgz#6c619e4f9c60308c38519498c14fbb10aacebb06" integrity sha512-ZTTX0MWrsQ2ZAhA1cejAwDLycFsd7I7nVtnkT3Ol0aqodaKW+0CTZDQ1uBv5whptCnc8e8HeRRJxRs0kmm/Qfw== @@ -567,23 +540,12 @@ http-errors@1.7.3, http-errors@~1.7.2: statuses ">= 1.5.0 < 2" toidentifier "1.0.0" -http-errors@^1.6.3: - version "1.8.0" - resolved "https://registry.yarnpkg.com/http-errors/-/http-errors-1.8.0.tgz#75d1bbe497e1044f51e4ee9e704a62f28d336507" - integrity sha512-4I8r0C5JDhT5VkvI47QktDW75rNlGVsUf/8hzjCC/wkWI/jdTRmBb9aI7erSG82r1bjKY3F6k28WnsVxB1C73A== - dependencies: - depd "~1.1.2" - inherits "2.0.4" - setprototypeof "1.2.0" - statuses ">= 1.5.0 < 2" - toidentifier "1.0.0" - https-browserify@^1.0.0: version "1.0.0" resolved "https://registry.yarnpkg.com/https-browserify/-/https-browserify-1.0.0.tgz#ec06c10e0a34c0f2faf199f7fd7fc78fffd03c73" integrity sha1-7AbBDgo0wPL68Zn3/X/Hj//QPHM= -https-proxy-agent@5.0.0: +https-proxy-agent@5.0.0, https-proxy-agent@^5.0.0: version "5.0.0" resolved "https://registry.yarnpkg.com/https-proxy-agent/-/https-proxy-agent-5.0.0.tgz#e2a90542abb68a762e0a0850f6c9edadfd8506b2" integrity sha512-EkYm5BcKUGiduxzSt3Eppko+PiNWNEpa4ySk9vTC6wDsQJW9rHSa+UhGNJoRYp7bz6Ht1eaRIa6QaJqO5rCFbA== @@ -636,13 +598,6 @@ inherits@2.0.3: resolved "https://registry.yarnpkg.com/inherits/-/inherits-2.0.3.tgz#633c2c83e3da42a502f52466022480f4208261de" integrity sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4= -is-generator-function@^1.0.7: - version "1.0.10" - resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.10.tgz#f1558baf1ac17e0deea7c0415c438351ff2b3c72" - integrity sha512-jsEjy9l3yiXEQ+PsXdmBwEPcOxaXWLspKdplFUVI9vq1iZgIekeC0L167qeu86czQaxed3q/Uzuw0swL0irL8A== - dependencies: - has-tostringtag "^1.0.0" - isarray@^1.0.0, isarray@~1.0.0: version "1.0.0" resolved "https://registry.yarnpkg.com/isarray/-/isarray-1.0.0.tgz#bb935d48582cba168c06834957a54a3e07124f11" @@ -670,55 +625,6 @@ keygrip@~1.1.0: dependencies: tsscmp "1.0.6" -koa-compose@^3.0.0: - version "3.2.1" - resolved "https://registry.yarnpkg.com/koa-compose/-/koa-compose-3.2.1.tgz#a85ccb40b7d986d8e5a345b3a1ace8eabcf54de7" - integrity sha1-qFzLQLfZhtjlo0Wzoazo6rz1Tec= - dependencies: - any-promise "^1.1.0" - -koa-compose@^4.1.0: - version "4.1.0" - resolved "https://registry.yarnpkg.com/koa-compose/-/koa-compose-4.1.0.tgz#507306b9371901db41121c812e923d0d67d3e877" - integrity sha512-8ODW8TrDuMYvXRwra/Kh7/rJo9BtOfPc6qO8eAfC80CnCvSjSl0bkRM24X6/XBBEyj0v1nRUQ1LyOy3dbqOWXw== - -koa-convert@^1.2.0: - version "1.2.0" - resolved "https://registry.yarnpkg.com/koa-convert/-/koa-convert-1.2.0.tgz#da40875df49de0539098d1700b50820cebcd21d0" - integrity sha1-2kCHXfSd4FOQmNFwC1CCDOvNIdA= - dependencies: - co "^4.6.0" - koa-compose "^3.0.0" - -koa@^2.13.0: - version "2.13.1" - resolved "https://registry.yarnpkg.com/koa/-/koa-2.13.1.tgz#6275172875b27bcfe1d454356a5b6b9f5a9b1051" - integrity sha512-Lb2Dloc72auj5vK4X4qqL7B5jyDPQaZucc9sR/71byg7ryoD1NCaCm63CShk9ID9quQvDEi1bGR/iGjCG7As3w== - dependencies: - accepts "^1.3.5" - cache-content-type "^1.0.0" - content-disposition "~0.5.2" - content-type "^1.0.4" - cookies "~0.8.0" - debug "~3.1.0" - delegates "^1.0.0" - depd "^2.0.0" - destroy "^1.0.4" - encodeurl "^1.0.2" - escape-html "^1.0.3" - fresh "~0.5.2" - http-assert "^1.3.0" - http-errors "^1.6.3" - is-generator-function "^1.0.7" - koa-compose "^4.1.0" - koa-convert "^1.2.0" - on-finished "^2.3.0" - only "~0.0.2" - parseurl "^1.3.2" - statuses "^1.5.0" - type-is "^1.6.16" - vary "^1.1.2" - lie@~3.3.0: version "3.3.0" resolved "https://registry.yarnpkg.com/lie/-/lie-3.3.0.tgz#dcf82dee545f46074daf200c7c1c5a08e0f40f6a" @@ -733,6 +639,11 @@ locate-path@^5.0.0: dependencies: p-locate "^4.1.0" +lru_map@^0.3.3: + version "0.3.3" + resolved "https://registry.yarnpkg.com/lru_map/-/lru_map-0.3.3.tgz#b5c8351b9464cbd750335a79650a0ec0e56118dd" + integrity sha1-tcg1G5Rky9dQM1p5ZQoOwOVhGN0= + luxon@^2.0.1: version "2.0.2" resolved "https://registry.yarnpkg.com/luxon/-/luxon-2.0.2.tgz#11f2cd4a11655fdf92e076b5782d7ede5bcdd133" @@ -747,11 +658,6 @@ md5.js@^1.3.4: inherits "^2.0.1" safe-buffer "^5.1.2" -media-typer@0.3.0: - version "0.3.0" - resolved "https://registry.yarnpkg.com/media-typer/-/media-typer-0.3.0.tgz#8710d7af0aa626f8fffa1ce00168545263255748" - integrity sha1-hxDXrwqmJvj/+hzgAWhUUmMlV0g= - miller-rabin@^4.0.0: version "4.0.1" resolved "https://registry.yarnpkg.com/miller-rabin/-/miller-rabin-4.0.1.tgz#f080351c865b0dc562a8462966daa53543c78a4d" @@ -760,18 +666,6 @@ miller-rabin@^4.0.0: bn.js "^4.0.0" brorand "^1.0.1" -mime-db@1.49.0: - version "1.49.0" - resolved "https://registry.yarnpkg.com/mime-db/-/mime-db-1.49.0.tgz#f3dfde60c99e9cf3bc9701d687778f537001cbed" - integrity sha512-CIc8j9URtOVApSFCQIF+VBkX1RwXp/oMMOrqdyXSBXq5RWNEsRfyj1kiRnQgmNXmHxPoFIxOroKA3zcU9P+nAA== - -mime-types@^2.1.18, mime-types@~2.1.24: - version "2.1.32" - resolved "https://registry.yarnpkg.com/mime-types/-/mime-types-2.1.32.tgz#1d00e89e7de7fe02008db61001d9e02852670fd5" - integrity sha512-hJGaVS4G4c9TSMYh2n6SQAGrC4RnfU+daP8G7cSCmaqNjiOoUY0VHCMS42pxnQmVF1GWwFhbHWn3RIxCqTmZ9A== - dependencies: - mime-db "1.49.0" - minimalistic-assert@^1.0.0, minimalistic-assert@^1.0.1: version "1.0.1" resolved "https://registry.yarnpkg.com/minimalistic-assert/-/minimalistic-assert-1.0.1.tgz#2e194de044626d4a10e7f7fbc00ce73e83e4d5c7" @@ -801,21 +695,11 @@ mkdirp@^0.5.1: dependencies: minimist "^1.2.5" -ms@2.0.0: - version "2.0.0" - resolved "https://registry.yarnpkg.com/ms/-/ms-2.0.0.tgz#5608aeadfc00be6c2901df5f9861788de0d597c8" - integrity sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g= - ms@2.1.2: version "2.1.2" resolved "https://registry.yarnpkg.com/ms/-/ms-2.1.2.tgz#d09d1f357b443f493382a8eb3ccd183872ae6009" integrity sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w== -negotiator@0.6.2: - version "0.6.2" - resolved "https://registry.yarnpkg.com/negotiator/-/negotiator-0.6.2.tgz#feacf7ccf525a77ae9634436a64883ffeca346fb" - integrity sha512-hZXc7K2e+PgeI1eDBe/10Ard4ekbfrrqG8Ep+8Jmf4JID2bNg7NvCPOZN+kfF574pFQI7mum2AUqDidoKqcTOw== - node-fetch@2.6.1: version "2.6.1" resolved "https://registry.yarnpkg.com/node-fetch/-/node-fetch-2.6.1.tgz#045bd323631f76ed2e2b55573394416b639a0052" @@ -855,13 +739,6 @@ object-assign@^4.1.1: resolved "https://registry.yarnpkg.com/object-assign/-/object-assign-4.1.1.tgz#2109adc7965887cfc05cbbd442cac8bfbb360863" integrity sha1-IQmtx5ZYh8/AXLvUQsrIv7s2CGM= -on-finished@^2.3.0: - version "2.3.0" - resolved "https://registry.yarnpkg.com/on-finished/-/on-finished-2.3.0.tgz#20f1336481b083cd75337992a16971aa2d906947" - integrity sha1-IPEzZIGwg811M3mSoWlxqi2QaUc= - dependencies: - ee-first "1.1.1" - once@^1.3.0, once@^1.3.1, once@^1.4.0: version "1.4.0" resolved "https://registry.yarnpkg.com/once/-/once-1.4.0.tgz#583b1aa775961d4b113ac17d9c50baef9dd76bd1" @@ -869,11 +746,6 @@ once@^1.3.0, once@^1.3.1, once@^1.4.0: dependencies: wrappy "1" -only@~0.0.2: - version "0.0.2" - resolved "https://registry.yarnpkg.com/only/-/only-0.0.2.tgz#2afde84d03e50b9a8edc444e30610a70295edfb4" - integrity sha1-Kv3oTQPlC5qO3EROMGEKcCle37Q= - os-browserify@^0.3.0: version "0.3.0" resolved "https://registry.yarnpkg.com/os-browserify/-/os-browserify-0.3.0.tgz#854373c7f5c2315914fc9bfc6bd8238fdda1ec27" @@ -914,11 +786,6 @@ parse-asn1@^5.0.0, parse-asn1@^5.1.5: pbkdf2 "^3.0.3" safe-buffer "^5.1.1" -parseurl@^1.3.2: - version "1.3.3" - resolved "https://registry.yarnpkg.com/parseurl/-/parseurl-1.3.3.tgz#9da19e7bee8d12dff0513ed5b76957793bc2e8d4" - integrity sha512-CiyeOxFT/JZyN5m0z9PfXw4SCBJ6Sygz1Dpl0wqjlhDEGGBP1GnsUVEL0p63hoG1fcj3fHynXi9NYO4nWOL+qQ== - path-browserify@0.0.1: version "0.0.1" resolved "https://registry.yarnpkg.com/path-browserify/-/path-browserify-0.0.1.tgz#e6c4ddd7ed3aa27c68a20cc4e50e1a4ee83bbc4a" @@ -1107,16 +974,16 @@ ripemd160@^2.0.0, ripemd160@^2.0.1: hash-base "^3.0.0" inherits "^2.0.1" -safe-buffer@5.1.2, safe-buffer@~5.1.0, safe-buffer@~5.1.1: - version "5.1.2" - resolved "https://registry.yarnpkg.com/safe-buffer/-/safe-buffer-5.1.2.tgz#991ec69d296e0313747d59bdfd2b745c35f8828d" - integrity sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g== - safe-buffer@^5.0.1, safe-buffer@^5.1.0, safe-buffer@^5.1.1, safe-buffer@^5.1.2, safe-buffer@^5.2.0, safe-buffer@~5.2.0: version "5.2.1" resolved "https://registry.yarnpkg.com/safe-buffer/-/safe-buffer-5.2.1.tgz#1eaf9fa9bdb1fdd4ec75f58f9cdb4e6b7827eec6" integrity sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ== +safe-buffer@~5.1.0, safe-buffer@~5.1.1: + version "5.1.2" + resolved "https://registry.yarnpkg.com/safe-buffer/-/safe-buffer-5.1.2.tgz#991ec69d296e0313747d59bdfd2b745c35f8828d" + integrity sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g== + "safer-buffer@>= 2.1.2 < 3", safer-buffer@^2.1.0: version "2.1.2" resolved "https://registry.yarnpkg.com/safer-buffer/-/safer-buffer-2.1.2.tgz#44fa161b0187b9549dd84bb91802f9bd8385cd6a" @@ -1142,11 +1009,6 @@ setprototypeof@1.1.1: resolved "https://registry.yarnpkg.com/setprototypeof/-/setprototypeof-1.1.1.tgz#7e95acb24aa92f5885e0abef5ba131330d4ae683" integrity sha512-JvdAWfbXeIGaZ9cILp38HntZSFSo3mWg6xGcJJsd+d4aRMOqauag1C63dJfDw7OaMYwEbHMOxEZ1lqVRYP2OAw== -setprototypeof@1.2.0: - version "1.2.0" - resolved "https://registry.yarnpkg.com/setprototypeof/-/setprototypeof-1.2.0.tgz#66c9a24a73f9fc28cbe66b09fed3d33dcaf1b424" - integrity sha512-E5LDX7Wrp85Kil5bhZv46j8jOeboKq5JMmYM3gVGdGH8xFpPWXUMsNrlODCrkoxMEeNi/XZIwuRvY4XNwYMJpw== - sha.js@^2.4.0, sha.js@^2.4.8: version "2.4.11" resolved "https://registry.yarnpkg.com/sha.js/-/sha.js-2.4.11.tgz#37a5cf0b81ecbc6943de109ba2960d1b26584ae7" @@ -1160,10 +1022,10 @@ shadow-cljs-jar@1.3.2: resolved "https://registry.yarnpkg.com/shadow-cljs-jar/-/shadow-cljs-jar-1.3.2.tgz#97273afe1747b6a2311917c1c88d9e243c81957b" integrity sha512-XmeffAZHv8z7451kzeq9oKh8fh278Ak+UIOGGrapyqrFBB773xN8vMQ3O7J7TYLnb9BUwcqadKkmgaq7q6fhZg== -shadow-cljs@^2.15.2: - version "2.15.4" - resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.15.4.tgz#0d657fc8ab9a02d8980db5c49cb1622e8fc6fa52" - integrity sha512-xn8UsiVpOf2LTsQZLsCa910CcMCYdMRT6STAsgveOEIncC9cunGdqE7cTq69vTmIijVQmzf0A1nALidyzO3Hcw== +shadow-cljs@^2.15.10: + version "2.15.10" + resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.15.10.tgz#b1df65a51707a7c34dad2c788a12edeb41e0321c" + integrity sha512-r02f7pvZefiaATt3k7oAb8PNQKaA67iFoowS88Jaf8IClRQL3plBazkDAUWX5yQd9QfT4WhGr6kP0GTzTidQSg== dependencies: node-libs-browser "^2.2.1" readline-sync "^1.4.7" @@ -1179,10 +1041,10 @@ source-map-support@^0.4.15: dependencies: source-map "^0.5.6" -source-map-support@^0.5.19: - version "0.5.19" - resolved "https://registry.yarnpkg.com/source-map-support/-/source-map-support-0.5.19.tgz#a98b62f86dcaf4f67399648c085291ab9e8fed61" - integrity sha512-Wonm7zOCIJzBGQdB+thsPar0kYuCIzYvxZwlBa87yi/Mdjv7Tip2cyVbLj5o0cFPN4EVkuTwb3GDDyUx2DGnGw== +source-map-support@^0.5.20: + version "0.5.20" + resolved "https://registry.yarnpkg.com/source-map-support/-/source-map-support-0.5.20.tgz#12166089f8f5e5e8c56926b377633392dd2cb6c9" + integrity sha512-n1lZZ8Ve4ksRqizaBQgxXDgKwttHDhyfQjA6YZZn8+AroHbsIz+JjwxQDxbp+7y5OYCI8t1Yk7etjD9CRd2hIw== dependencies: buffer-from "^1.0.0" source-map "^0.6.0" @@ -1197,7 +1059,7 @@ source-map@^0.6.0: resolved "https://registry.yarnpkg.com/source-map/-/source-map-0.6.1.tgz#74722af32e9614e9c287a8d0bbde48b5e2f1a263" integrity sha512-UjgapumWlbMhkBgzT7Ykc5YXUT46F0iKu8SGXq0bcwP5dz/h0Plj6enJqjz1Zbq2l5WaqYnrVbwWOWMyF3F47g== -"statuses@>= 1.5.0 < 2", statuses@^1.5.0: +"statuses@>= 1.5.0 < 2": version "1.5.0" resolved "https://registry.yarnpkg.com/statuses/-/statuses-1.5.0.tgz#161c7dac177659fd9811f43771fa99381478628c" integrity sha1-Fhx9rBd2Wf2YEfQ3cfqZOBR4Yow= @@ -1278,6 +1140,11 @@ toidentifier@1.0.0: resolved "https://registry.yarnpkg.com/toidentifier/-/toidentifier-1.0.0.tgz#7e1be3470f1e77948bc43d94a3c8f4d7752ba553" integrity sha512-yaOH/Pk/VEhBWWTlhI+qXxDFXlejDGcQipMlyxda9nthulaxLZUNcUqFxokp0vcYnvteJln5FNQDRrxj3YcbVw== +tslib@^1.9.3: + version "1.14.1" + resolved "https://registry.yarnpkg.com/tslib/-/tslib-1.14.1.tgz#cf2d38bdc34a134bcaf1091c41f6619e2f672d00" + integrity sha512-Xni35NKzjgMrwevysHTCArtLDpPvye8zV/0E4EyYn43P7/7qvQwPh9BGkHewbMulVntbigmcT7rdX3BNo9wRJg== + tsscmp@1.0.6: version "1.0.6" resolved "https://registry.yarnpkg.com/tsscmp/-/tsscmp-1.0.6.tgz#85b99583ac3589ec4bfef825b5000aa911d605eb" @@ -1288,14 +1155,6 @@ tty-browserify@0.0.0: resolved "https://registry.yarnpkg.com/tty-browserify/-/tty-browserify-0.0.0.tgz#a157ba402da24e9bf957f9aa69d524eed42901a6" integrity sha1-oVe6QC2iTpv5V/mqadUk7tQpAaY= -type-is@^1.6.16: - version "1.6.18" - resolved "https://registry.yarnpkg.com/type-is/-/type-is-1.6.18.tgz#4e552cd05df09467dcbc4ef739de89f2cf37c131" - integrity sha512-TkRKr9sUTxEH8MdfuCSP7VizJyzRNMjj2J2do2Jr3Kym598JVdEksuzPQCnlFPW4ky9Q+iA+ma9BGm06XQBy8g== - dependencies: - media-typer "0.3.0" - mime-types "~2.1.24" - unbzip2-stream@1.3.3: version "1.3.3" resolved "https://registry.yarnpkg.com/unbzip2-stream/-/unbzip2-stream-1.3.3.tgz#d156d205e670d8d8c393e1c02ebd506422873f6a" @@ -1336,11 +1195,6 @@ util@^0.11.0: dependencies: inherits "2.0.3" -vary@^1.1.2: - version "1.1.2" - resolved "https://registry.yarnpkg.com/vary/-/vary-1.1.2.tgz#2299f02c6ded30d4a5961b0b9f74524a18f634fc" - integrity sha1-IpnwLG3tMNSllhsLn3RSShj2NPw= - vm-browserify@^1.0.1: version "1.1.2" resolved "https://registry.yarnpkg.com/vm-browserify/-/vm-browserify-1.1.2.tgz#78641c488b8e6ca91a75f511e7a3b32a86e5dda0" @@ -1394,8 +1248,3 @@ yauzl@^2.10.0: dependencies: buffer-crc32 "~0.2.3" fd-slicer "~1.1.0" - -ylru@^1.2.0: - version "1.2.1" - resolved "https://registry.yarnpkg.com/ylru/-/ylru-1.2.1.tgz#f576b63341547989c1de7ba288760923b27fe84f" - integrity sha512-faQrqNMzcPCHGVC2aaOINk13K+aaBDUPjGWl0teOXywElLjyVAB6Oe2jj62jHYtwsU49jXhScYbvPENK+6zAvQ== diff --git a/frontend/deps.edn b/frontend/deps.edn index 3ba3255a8..b878e722f 100644 --- a/frontend/deps.edn +++ b/frontend/deps.edn @@ -4,7 +4,7 @@ {:local/root "../common"} binaryage/devtools {:mvn/version "RELEASE"} - metosin/reitit-core {:mvn/version "0.5.13"} + metosin/reitit-core {:mvn/version "0.5.15"} funcool/beicon {:mvn/version "2021.07.05-1"} funcool/okulary {:mvn/version "2020.04.14-0"} @@ -23,7 +23,8 @@ :dev {:extra-deps - {thheller/shadow-cljs {:mvn/version "2.15.2"}}} + {thheller/shadow-cljs {:mvn/version "2.15.9"} + cider/cider-nrepl {:mvn/version "0.26.0"}}} :shadow-cljs {:main-opts ["-m" "shadow.cljs.devtools.cli"]} diff --git a/frontend/gulpfile.js b/frontend/gulpfile.js index 03c4f1c27..5a64cd8a3 100644 --- a/frontend/gulpfile.js +++ b/frontend/gulpfile.js @@ -33,7 +33,7 @@ paths.dist = "./target/dist/"; // Templates function readLocales() { - const langs = ["ca", "de", "el", "en", "es", "fr", "tr", "ru", "zh_CN", "pt_BR", "ro"]; + const langs = ["ar", "he", "ca", "de", "el", "en", "es", "fr", "tr", "ru", "zh_CN", "pt_BR", "ro"]; const result = {}; for (let lang of langs) { diff --git a/frontend/package.json b/frontend/package.json index 13261d45a..74b63207e 100644 --- a/frontend/package.json +++ b/frontend/package.json @@ -12,7 +12,15 @@ "defaults" ], "scripts": { - "validate-translations": "node ./scripts/validate-translations.js" + "validate-translations": "node ./scripts/validate-translations.js", + "watch-main": "shadow-cljs watch main", + "watch-gulp": "gulp watch", + "test-watch-compile": "shadow-cljs watch test", + "test-run": "node target/tests.js", + "test-watch-run": "nodemon --signal SIGKILL --watch target --exec npm run test-run", + "test-watch": "npm-run-all --parallel test-watch-compile test-watch-run", + "test": "npm run test-watch", + "start": "npm-run-all --parallel watch-gulp watch-main" }, "devDependencies": { "autoprefixer": "^10.2.4", @@ -27,21 +35,25 @@ "gulp-sourcemaps": "^3.0.0", "gulp-svg-sprite": "^1.5.0", "map-stream": "0.0.7", - "marked": "^2.1.1", + "marked": "^3.0.4", "mkdirp": "^1.0.4", + "nodemon": "^2.0.13", + "npm-run-all": "^4.1.5", "postcss": "^8.3.5", "postcss-clean": "^1.2.2", "rimraf": "^3.0.0", "sass": "^1.35.1", - "shadow-cljs": "2.15.2" + "shadow-cljs": "2.15.9" }, "dependencies": { + "@sentry/browser": "^6.12.0", + "@sentry/tracing": "^6.12.0", "date-fns": "^2.22.1", "draft-js": "^0.11.7", "highlight.js": "^11.0.1", "js-beautify": "^1.14.0", "jszip": "^3.6.0", - "luxon": "^1.26.0", + "luxon": "^2.0.2", "mousetrap": "^1.6.5", "opentype.js": "^1.3.3", "randomcolor": "^0.6.2", diff --git a/frontend/resources/images/features/advanced-proto.gif b/frontend/resources/images/features/advanced-proto.gif new file mode 100644 index 000000000..e8db03218 Binary files /dev/null and b/frontend/resources/images/features/advanced-proto.gif differ diff --git a/frontend/resources/images/features/booleans.gif b/frontend/resources/images/features/booleans.gif new file mode 100644 index 000000000..7b8f488be Binary files /dev/null and b/frontend/resources/images/features/booleans.gif differ diff --git a/frontend/resources/images/features/flows-proto.gif b/frontend/resources/images/features/flows-proto.gif new file mode 100644 index 000000000..eb3dfa6dc Binary files /dev/null and b/frontend/resources/images/features/flows-proto.gif differ diff --git a/frontend/resources/images/features/libraries-feature.gif b/frontend/resources/images/features/libraries-feature.gif new file mode 100644 index 000000000..3e996a6c2 Binary files /dev/null and b/frontend/resources/images/features/libraries-feature.gif differ diff --git a/frontend/resources/images/icons/boolean-difference.svg b/frontend/resources/images/icons/boolean-difference.svg new file mode 100644 index 000000000..4d5c7f6a8 --- /dev/null +++ b/frontend/resources/images/icons/boolean-difference.svg @@ -0,0 +1,3 @@ + diff --git a/frontend/resources/images/icons/boolean-exclude.svg b/frontend/resources/images/icons/boolean-exclude.svg new file mode 100644 index 000000000..6a3865703 --- /dev/null +++ b/frontend/resources/images/icons/boolean-exclude.svg @@ -0,0 +1,3 @@ + diff --git a/frontend/resources/images/icons/boolean-flatten.svg b/frontend/resources/images/icons/boolean-flatten.svg new file mode 100644 index 000000000..f7816f8b5 --- /dev/null +++ b/frontend/resources/images/icons/boolean-flatten.svg @@ -0,0 +1,3 @@ + diff --git a/frontend/resources/images/icons/boolean-intersection.svg b/frontend/resources/images/icons/boolean-intersection.svg new file mode 100644 index 000000000..3480e6366 --- /dev/null +++ b/frontend/resources/images/icons/boolean-intersection.svg @@ -0,0 +1,3 @@ + diff --git a/frontend/resources/images/icons/boolean-union.svg b/frontend/resources/images/icons/boolean-union.svg new file mode 100644 index 000000000..fdeb117b7 --- /dev/null +++ b/frontend/resources/images/icons/boolean-union.svg @@ -0,0 +1,3 @@ + diff --git a/frontend/resources/images/icons/uxbox-logo-icon-loader.svg b/frontend/resources/images/icons/penpot-logo-icon-loader.svg similarity index 100% rename from frontend/resources/images/icons/uxbox-logo-icon-loader.svg rename to frontend/resources/images/icons/penpot-logo-icon-loader.svg diff --git a/frontend/resources/images/icons/uxbox-logo-icon.svg b/frontend/resources/images/icons/penpot-logo-icon.svg similarity index 100% rename from frontend/resources/images/icons/uxbox-logo-icon.svg rename to frontend/resources/images/icons/penpot-logo-icon.svg diff --git a/frontend/resources/images/icons/uxbox-logo.svg b/frontend/resources/images/icons/penpot-logo.svg similarity index 100% rename from frontend/resources/images/icons/uxbox-logo.svg rename to frontend/resources/images/icons/penpot-logo.svg diff --git a/frontend/resources/images/icons/position-bottom-center.svg b/frontend/resources/images/icons/position-bottom-center.svg new file mode 100644 index 000000000..002466ead --- /dev/null +++ b/frontend/resources/images/icons/position-bottom-center.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/images/icons/position-bottom-left.svg b/frontend/resources/images/icons/position-bottom-left.svg new file mode 100644 index 000000000..4811b74a9 --- /dev/null +++ b/frontend/resources/images/icons/position-bottom-left.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/images/icons/position-bottom-right.svg b/frontend/resources/images/icons/position-bottom-right.svg new file mode 100644 index 000000000..ebf861dcf --- /dev/null +++ b/frontend/resources/images/icons/position-bottom-right.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/images/icons/position-center.svg b/frontend/resources/images/icons/position-center.svg new file mode 100644 index 000000000..ce6695ba7 --- /dev/null +++ b/frontend/resources/images/icons/position-center.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/images/icons/position-top-center.svg b/frontend/resources/images/icons/position-top-center.svg new file mode 100644 index 000000000..5a971d427 --- /dev/null +++ b/frontend/resources/images/icons/position-top-center.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/images/icons/position-top-left.svg b/frontend/resources/images/icons/position-top-left.svg new file mode 100644 index 000000000..0285e444e --- /dev/null +++ b/frontend/resources/images/icons/position-top-left.svg @@ -0,0 +1,7 @@ + + diff --git a/frontend/resources/images/icons/position-top-right.svg b/frontend/resources/images/icons/position-top-right.svg new file mode 100644 index 000000000..838f63602 --- /dev/null +++ b/frontend/resources/images/icons/position-top-right.svg @@ -0,0 +1,6 @@ + diff --git a/frontend/resources/styles/common/base.scss b/frontend/resources/styles/common/base.scss index ddd623792..54032cad6 100644 --- a/frontend/resources/styles/common/base.scss +++ b/frontend/resources/styles/common/base.scss @@ -63,7 +63,7 @@ a { } p { - font-size: $fs13; + font-size: $fs12; margin-bottom: 1rem; line-height: $base-lh-sm; diff --git a/frontend/resources/styles/common/dependencies/fonts.scss b/frontend/resources/styles/common/dependencies/fonts.scss index 19e9b2f9c..75eb65c1f 100644 --- a/frontend/resources/styles/common/dependencies/fonts.scss +++ b/frontend/resources/styles/common/dependencies/fonts.scss @@ -21,7 +21,7 @@ $fs21: 1.315rem; $fs22: 1.375rem; $fs24: 1.5rem; $fs26: 1.625rem; -$fs28: 1.75rem; +$fs24: 1.75rem; $fs30: 1.875rem; $fs32: 2rem; $fs34: 2.125rem; diff --git a/frontend/resources/styles/common/dependencies/helpers.scss b/frontend/resources/styles/common/dependencies/helpers.scss index ed0f805c1..3562e9370 100644 --- a/frontend/resources/styles/common/dependencies/helpers.scss +++ b/frontend/resources/styles/common/dependencies/helpers.scss @@ -6,16 +6,9 @@ // Copyright (c) 2015-2016 Juan de la Cruz