diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index 60606932bf..fe1d14d908 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -5,6 +5,7 @@ promesa.exec.csp/go-loop clojure.core/loop rumext.v2/defc clojure.core/defn promesa.util/with-open clojure.core/with-open + app.common.schema.generators/let clojure.core/let app.common.data/export clojure.core/def app.common.data.macros/get-in clojure.core/get-in app.common.data.macros/with-open clojure.core/with-open diff --git a/backend/resources/log4j2-devenv.xml b/backend/resources/log4j2-devenv.xml index 7abb7a1885..ca1ab6739a 100644 --- a/backend/resources/log4j2-devenv.xml +++ b/backend/resources/log4j2-devenv.xml @@ -30,7 +30,7 @@ - + diff --git a/backend/resources/log4j2-experiments.xml b/backend/resources/log4j2-experiments.xml new file mode 100644 index 0000000000..88542c2774 --- /dev/null +++ b/backend/resources/log4j2-experiments.xml @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/backend/scripts/repl-test b/backend/scripts/repl-test new file mode 100755 index 0000000000..a1333a5317 --- /dev/null +++ b/backend/scripts/repl-test @@ -0,0 +1,49 @@ +#!/usr/bin/env bash + +source /home/penpot/backend/environ +export PENPOT_FLAGS="$PENPOT_FLAGS disable-backend-worker" + +export OPTIONS=" + -A:jmx-remote -A:dev \ + -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \ + -J-Djdk.attach.allowAttachSelf \ + -J-Dlog4j2.configurationFile=log4j2-experiments.xml \ + -J-XX:-OmitStackTraceInFastThrow \ + -J-XX:+UnlockDiagnosticVMOptions \ + -J-XX:+DebugNonSafepoints \ + -J-Djdk.tracePinnedThreads=full \ + -J-Dpolyglot.engine.WarnInterpreterOnly=false \ + -J--enable-preview"; + +# Setup HEAP +#export OPTIONS="$OPTIONS -J-Xms900m -J-Xmx900m -J-XX:+AlwaysPreTouch" +export OPTIONS="$OPTIONS -J-Xms1g -J-Xmx25g" +#export OPTIONS="$OPTIONS -J-Xms900m -J-Xmx900m -J-XX:+AlwaysPreTouch" + +export PENPOT_HTTP_SERVER_IO_THREADS=2 +export PENPOT_HTTP_SERVER_WORKER_THREADS=2 + +# Increase virtual thread pool size +# export OPTIONS="$OPTIONS -J-Djdk.virtualThreadScheduler.parallelism=16" + +# Disable C2 Compiler +# export OPTIONS="$OPTIONS -J-XX:TieredStopAtLevel=1" + +# Disable all compilers +# export OPTIONS="$OPTIONS -J-Xint" + +# Setup GC +export OPTIONS="$OPTIONS -J-XX:+UseG1GC -J-Xlog:gc:logs/gc.log" + + +# Setup GC +#export OPTIONS="$OPTIONS -J-XX:+UseZGC -J-XX:+ZGenerational -J-Xlog:gc:gc.log" + +# Enable ImageMagick v7.x support +# export OPTIONS="-J-Dim4java.useV7=true $OPTIONS"; + +export OPTIONS_EVAL="nil" +# export OPTIONS_EVAL="(set! *warn-on-reflection* true)" + +set -ex +exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -m rebel-readline.main \ No newline at end of file diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj index b4fe60c652..a9e883b8ff 100644 --- a/backend/src/app/config.clj +++ b/backend/src/app/config.clj @@ -209,7 +209,6 @@ (s/def ::telemetry-uri ::us/string) (s/def ::telemetry-with-taiga ::us/boolean) (s/def ::tenant ::us/string) -(s/def ::svgo-max-procs ::us/integer) (s/def ::config (s/keys :opt-un [::secret-key @@ -329,9 +328,7 @@ ::telemetry-uri ::telemetry-referer ::telemetry-with-taiga - ::tenant - - ::svgo-max-procs])) + ::tenant])) (def default-flags [:enable-backend-api-doc diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj index 942d01db7d..6e7407e17d 100644 --- a/backend/src/app/db.clj +++ b/backend/src/app/db.clj @@ -517,9 +517,11 @@ (defn rollback! ([conn] - (let [^Connection conn (get-connection conn)] - (l/trc :hint "explicit rollback requested") - (.rollback conn))) + (if (and (map? conn) (::savepoint conn)) + (rollback! conn (::savepoint conn)) + (let [^Connection conn (get-connection conn)] + (l/trc :hint "explicit rollback requested") + (.rollback conn)))) ([conn ^Savepoint sp] (let [^Connection conn (get-connection conn)] (l/trc :hint "explicit rollback requested (savepoint)") @@ -538,8 +540,13 @@ (let [conn (::conn system) sp (savepoint conn)] (try - (let [result (apply f system params)] - (release! conn sp) + (let [system' (-> system + (assoc ::savepoint sp) + (dissoc ::rollback)) + result (apply f system' params)] + (if (::rollback system) + (rollback! conn sp) + (release! conn sp)) result) (catch Throwable cause (.rollback ^Connection conn ^Savepoint sp) @@ -547,8 +554,10 @@ (::pool system) (with-atomic [conn (::pool system)] - (let [system (assoc system ::conn conn) - result (apply f system params)] + (let [system' (-> system + (assoc ::conn conn) + (dissoc ::rollback)) + result (apply f system' params)] (when (::rollback system) (rollback! conn)) result)) diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index 8eb6772403..e5e2673f73 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -16,21 +16,30 @@ [app.common.files.migrations :as fmg] [app.common.files.shapes-helpers :as cfsh] [app.common.files.validate :as cfv] + [app.common.geom.matrix :as gmt] [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] + [app.common.geom.shapes.path :as gshp] [app.common.logging :as l] + [app.common.math :as mth] + [app.common.schema :as sm] [app.common.svg :as csvg] [app.common.svg.shapes-builder :as sbuilder] + [app.common.types.color :as ctc] [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] [app.common.types.file :as ctf] + [app.common.types.page :as ctp] [app.common.types.pages-list :as ctpl] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] + [app.common.types.shape.path :as ctsp] + [app.common.types.shape.text :as ctsx] [app.common.uuid :as uuid] [app.db :as db] + [app.db.sql :as sql] [app.features.fdata :as fdata] [app.http.sse :as sse] [app.media :as media] @@ -41,29 +50,34 @@ [app.storage.tmp :as tmp] [app.svgo :as svgo] [app.util.blob :as blob] + [app.util.cache :as cache] [app.util.pointer-map :as pmap] [app.util.time :as dt] [buddy.core.codecs :as bc] [cuerdas.core :as str] [datoteka.io :as io] - [promesa.core :as p])) + [promesa.exec :as px] + [promesa.util :as pu])) (def ^:dynamic *stats* "A dynamic var for setting up state for collect stats globally." nil) -(def ^:dynamic *skip-on-error* - "A dynamic var for setting up the default error behavior." - true) +(def ^:dynamic *cache* + "A dynamic var for setting up a cache instance." + nil) + +(def ^:dynamic *skip-on-graphic-error* + "A dynamic var for setting up the default error behavior for graphics processing." + nil) (def ^:dynamic ^:private *system* "An internal var for making the current `system` available to all internal functions without the need to explicitly pass it top down." nil) -(def ^:dynamic ^:private *max-procs* - "A dynamic variable that can optionally indicates the maxumum number - of concurrent graphics migration processes." +(def ^:dynamic ^:private *team-id* + "A dynamic var that holds the current processing team-id." nil) (def ^:dynamic ^:private *file-stats* @@ -91,21 +105,279 @@ ;; FILE PREPARATION BEFORE MIGRATION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def valid-color? (sm/lazy-validator ::ctc/recent-color)) +(def valid-fill? (sm/lazy-validator ::cts/fill)) +(def valid-stroke? (sm/lazy-validator ::cts/stroke)) +(def valid-flow? (sm/lazy-validator ::ctp/flow)) + +(def valid-text-content? + (sm/lazy-validator ::ctsx/content)) + +(def valid-path-content? + (sm/lazy-validator ::ctsp/content)) + +(def valid-path-segment? + (sm/lazy-validator ::ctsp/segment)) + +(def valid-rgb-color-string? + (sm/lazy-validator ::ctc/rgb-color)) + (defn- prepare-file-data "Apply some specific migrations or fixes to things that are allowed in v1 but not in v2, or that are the result of old bugs." [file-data libraries] (let [detached-ids (volatile! #{}) - detach-shape (fn [container shape] - ;; Detach a shape. If it's inside a component, add it to detached-ids, for further use. + ;; Detach a shape. If it's inside a component, add it to detached-ids. This list + ;; is used later to process any other copy that was referencing a detached copy. (let [is-component? (let [root-shape (ctst/get-shape container (:id container))] (and (some? root-shape) (nil? (:parent-id root-shape))))] (when is-component? (vswap! detached-ids conj (:id shape))) (ctk/detach-shape shape))) + fix-bad-children + (fn [file-data] + ;; Remove any child that does not exist. And also remove duplicated children. + (letfn [(fix-container + [container] + (d/update-when container :objects update-vals (partial fix-shape container))) + + (fix-shape + [container shape] + (let [objects (:objects container)] + (d/update-when shape :shapes + (fn [shapes] + (->> shapes + (d/removev #(nil? (get objects %))) + (into [] (distinct)))))))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-missing-image-metadata + (fn [file-data] + ;; Delete broken image shapes with no metadata. + (letfn [(fix-container + [container] + (d/update-when container :objects #(reduce-kv fix-shape % %))) + + (fix-shape + [objects id shape] + (if (and (cfh/image-shape? shape) + (nil? (:metadata shape))) + (-> objects + (dissoc id) + (d/update-in-when [(:parent-id shape) :shapes] + (fn [shapes] (filterv #(not= id %) shapes)))) + objects))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-page-invalid-options + (fn [file-data] + (letfn [(update-page [page] + (update page :options fix-options)) + + (fix-background [options] + (if (and (contains? options :background) + (not (valid-rgb-color-string? (:background options)))) + (dissoc options :background) + options)) + + (fix-options [options] + (-> options + ;; Some pages has invalid data on flows, we proceed just to + ;; delete them. + (d/update-when :flows #(filterv valid-flow? %)) + (fix-background)))] + + (update file-data :pages-index update-vals update-page))) + + delete-big-geometry-shapes + (fn [file-data] + ;; At some point in time, we had a bug that generated shapes + ;; with huge geometries that did not validate the + ;; schema. Since we don't have a way to fix those shapes, we + ;; simply proceed to delete it. We ignore path type shapes + ;; because they have not been affected by the bug. + (letfn [(fix-container + [container] + (d/update-when container :objects #(reduce-kv fix-shape % %))) + + (fix-shape + [objects id shape] + (cond + (or (cfh/path-shape? shape) + (cfh/bool-shape? shape)) + objects + + (or (and (number? (:x shape)) (not (sm/valid-safe-number? (:x shape)))) + (and (number? (:y shape)) (not (sm/valid-safe-number? (:y shape)))) + (and (number? (:width shape)) (not (sm/valid-safe-number? (:width shape)))) + (and (number? (:height shape)) (not (sm/valid-safe-number? (:height shape))))) + (-> objects + (dissoc id) + (d/update-in-when [(:parent-id shape) :shapes] + (fn [shapes] (filterv #(not= id %) shapes)))) + + :else + objects))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-misc-shape-issues + (fn [file-data] + (letfn [(fix-container [container] + (d/update-when container :objects update-vals fix-shape)) + + (fix-shape [shape] + (cond-> shape + ;; Some shapes has invalid gap value + (contains? shape :layout-gap) + (d/update-in-when [:layout-gap :column-gap] + (fn [gap] + (if (or (= gap ##Inf) + (= gap ##-Inf)) + 0 + gap))) + + ;; Fix broken fills + (seq (:fills shape)) + (update :fills (fn [fills] (filterv valid-fill? fills))) + + ;; Fix broken strokes + (seq (:strokes shape)) + (update :strokes (fn [strokes] (filterv valid-stroke? strokes))) + + ;; Fix some broken layout related attrs, probably + ;; of copypaste on flex layout betatest period + (true? (:layout shape)) + (assoc :layout :flex) + + (number? (:layout-gap shape)) + (as-> shape (let [n (:layout-gap shape)] + (assoc shape :layout-gap {:row-gap n :column-gap n})))))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + ;; There are some bugs in the past that allows convert text to + ;; path and this fix tries to identify this cases and fix them converting + ;; the shape back to text shape + + fix-text-shapes-converted-to-path + (fn [file-data] + (letfn [(fix-container [container] + (d/update-when container :objects update-vals fix-shape)) + + (fix-shape [shape] + (if (and (cfh/path-shape? shape) + (contains? shape :content) + (some? (:selrect shape)) + (valid-text-content? (:content shape))) + (let [selrect (:selrect shape)] + (-> shape + (assoc :x (:x selrect)) + (assoc :y (:y selrect)) + (assoc :width (:width selrect)) + (assoc :height (:height selrect)) + (assoc :type :text))) + shape))] + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-broken-paths + (fn [file-data] + (letfn [(fix-container [container] + (d/update-when container :objects update-vals fix-shape)) + + (fix-shape [shape] + (cond + (and (cfh/path-shape? shape) + (seq (:content shape)) + (not (valid-path-content? (:content shape)))) + (let [shape (update shape :content fix-path-content) + [points selrect] (gshp/content->points+selrect shape (:content shape))] + (-> shape + (dissoc :bool-content) + (dissoc :bool-type) + (assoc :points points) + (assoc :selrect selrect))) + + ;; When we fount a bool shape with no content, + ;; we convert it to a simple rect + (and (cfh/bool-shape? shape) + (not (seq (:bool-content shape)))) + (let [selrect (or (:selrect shape) + (grc/make-rect)) + points (grc/rect->points selrect)] + (-> shape + (assoc :x (:x selrect)) + (assoc :y (:y selrect)) + (assoc :width (:height selrect)) + (assoc :height (:height selrect)) + (assoc :selrect selrect) + (assoc :points points) + (assoc :type :rect) + (assoc :transform (gmt/matrix)) + (assoc :transform-inverse (gmt/matrix)) + (dissoc :bool-content) + (dissoc :shapes) + (dissoc :content))) + + :else + shape)) + + (fix-path-content [content] + (let [[seg1 :as content] (filterv valid-path-segment? content)] + (if (and seg1 (not= :move-to (:command seg1))) + (let [params (select-keys (:params seg1) [:x :y])] + (into [{:command :move-to :params params}] content)) + content)))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-recent-colors + (fn [file-data] + ;; Remove invalid colors in :recent-colors + (d/update-when file-data :recent-colors + (fn [colors] + (filterv valid-color? colors)))) + + fix-broken-parents + (fn [file-data] + ;; Find children shapes whose parent-id is not set to the parent that contains them. + ;; Remove them from the parent :shapes list. + (letfn [(fix-container + [container] + (d/update-when container :objects #(reduce-kv fix-shape % %))) + + (fix-shape + [objects id shape] + (reduce (fn [objects child-id] + (let [child (get objects child-id)] + (cond-> objects + (and (some? child) (not= id (:parent-id child))) + (d/update-in-when [id :shapes] + (fn [shapes] (filterv #(not= child-id %) shapes)))))) + objects + (:shapes shape)))] + + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + fix-orphan-shapes (fn [file-data] ;; Find shapes that are not listed in their parent's children list. @@ -127,13 +399,13 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) remove-nested-roots (fn [file-data] ;; Remove :component-root in head shapes that are nested. (letfn [(fix-container [container] - (update container :objects update-vals (partial fix-shape container))) + (d/update-when container :objects update-vals (partial fix-shape container))) (fix-shape [container shape] (let [parent (ctst/get-shape container (:parent-id shape))] @@ -144,13 +416,13 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) add-not-nested-roots (fn [file-data] ;; Add :component-root in head shapes that are not nested. (letfn [(fix-container [container] - (update container :objects update-vals (partial fix-shape container))) + (d/update-when container :objects update-vals (partial fix-shape container))) (fix-shape [container shape] (let [parent (ctst/get-shape container (:parent-id shape))] @@ -161,13 +433,13 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) fix-orphan-copies (fn [file-data] ;; Detach shapes that were inside a copy (have :shape-ref) but now they aren't. (letfn [(fix-container [container] - (update container :objects update-vals (partial fix-shape container))) + (d/update-when container :objects update-vals (partial fix-shape container))) (fix-shape [container shape] (let [parent (ctst/get-shape container (:parent-id shape))] @@ -179,7 +451,7 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) remap-refs (fn [file-data] @@ -223,32 +495,32 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) - fix-copies-of-detached + fix-converted-copies (fn [file-data] - ;; Find any copy that is referencing a detached shape inside a component, and - ;; undo the nested copy, converting it into a direct copy. + ;; If the user has created a copy and then converted into a path or bool, + ;; detach it because the synchronization will no longer work. (letfn [(fix-container [container] - (update container :objects update-vals fix-shape)) + (d/update-when container :objects update-vals (partial fix-shape container))) + + (fix-shape [container shape] + (if (and (ctk/instance-head? shape) + (or (cfh/path-shape? shape) + (cfh/bool-shape? shape))) + (detach-shape container shape) + shape))] - (fix-shape [shape] - (cond-> shape - (@detached-ids (:shape-ref shape)) - (dissoc shape - :component-id - :component-file - :component-root)))] (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) transform-to-frames (fn [file-data] ;; Transform component and copy heads to frames, and set the ;; frame-id of its childrens (letfn [(fix-container [container] - (update container :objects update-vals fix-shape)) + (d/update-when container :objects update-vals fix-shape)) (fix-shape [shape] (if (or (nil? (:parent-id shape)) (ctk/instance-head? shape)) @@ -262,7 +534,7 @@ shape))] (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) remap-frame-ids (fn [file-data] @@ -270,7 +542,7 @@ ;; to point to the head instance. (letfn [(fix-container [container] - (update container :objects update-vals (partial fix-shape container))) + (d/update-when container :objects update-vals (partial fix-shape container))) (fix-shape [container shape] @@ -280,14 +552,14 @@ shape)))] (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) fix-frame-ids (fn [file-data] ;; Ensure that frame-id of all shapes point to the parent or to the frame-id ;; of the parent, and that the destination is indeed a frame. (letfn [(fix-container [container] - (update container :objects #(cfh/reduce-objects % fix-shape %))) + (d/update-when container :objects #(cfh/reduce-objects % fix-shape %))) (fix-shape [objects shape] (let [parent (when (:parent-id shape) @@ -304,7 +576,7 @@ (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container)))) + (d/update-when :components update-vals fix-container)))) fix-component-nil-objects (fn [file-data] @@ -316,38 +588,89 @@ (dissoc component :objects)) component))] (-> file-data - (update :components update-vals fix-component)))) + (d/update-when :components update-vals fix-component)))) fix-false-copies (fn [file-data] ;; Find component heads that are not main-instance but have not :shape-ref. + ;; Also shapes that have :shape-ref but are not in a copy. (letfn [(fix-container [container] - (update container :objects update-vals fix-shape)) + (d/update-when container :objects update-vals (partial fix-shape container))) (fix-shape - [shape] - (if (and (ctk/instance-head? shape) - (not (ctk/main-instance? shape)) - (not (ctk/in-component-copy? shape))) - (ctk/detach-shape shape) + [container shape] + (if (or (and (ctk/instance-head? shape) + (not (ctk/main-instance? shape)) + (not (ctk/in-component-copy? shape))) + (and (ctk/in-component-copy? shape) + (nil? (ctn/get-head-shape (:objects container) shape {:allow-main? true})))) + (detach-shape container shape) shape))] (-> file-data (update :pages-index update-vals fix-container) - (update :components update-vals fix-container))))] + (d/update-when :components update-vals fix-container)))) + + fix-copies-of-detached + (fn [file-data] + ;; Find any copy that is referencing a shape inside a component that have + ;; been detached in a previous fix. If so, undo the nested copy, converting + ;; it into a direct copy. + ;; + ;; WARNING: THIS SHOULD BE CALLED AT THE END OF THE PROCESS. + (letfn [(fix-container [container] + (d/update-when container :objects update-vals fix-shape)) + + (fix-shape [shape] + (cond-> shape + (@detached-ids (:shape-ref shape)) + (dissoc shape + :component-id + :component-file + :component-root)))] + (-> file-data + (update :pages-index update-vals fix-container) + (d/update-when :components update-vals fix-container)))) + + fix-shape-nil-parent-id + (fn [file-data] + ;; Ensure that parent-id and frame-id are not nil + (letfn [(fix-container [container] + (d/update-when container :objects update-vals fix-shape)) + + (fix-shape [shape] + (let [frame-id (or (:frame-id shape) + uuid/zero) + parent-id (or (:parent-id shape) + frame-id)] + (assoc shape :frame-id frame-id + :parent-id parent-id)))] + (-> file-data + (update :pages-index update-vals fix-container))))] (-> file-data + (fix-page-invalid-options) + (fix-bad-children) + (fix-misc-shape-issues) + (fix-recent-colors) + (fix-missing-image-metadata) + (fix-text-shapes-converted-to-path) + (fix-broken-paths) + (delete-big-geometry-shapes) + (fix-broken-parents) (fix-orphan-shapes) + (fix-orphan-copies) (remove-nested-roots) (add-not-nested-roots) - (fix-orphan-copies) (remap-refs) - (fix-copies-of-detached) + (fix-converted-copies) (transform-to-frames) (remap-frame-ids) (fix-frame-ids) (fix-component-nil-objects) - (fix-false-copies)))) + (fix-false-copies) + (fix-shape-nil-parent-id) + (fix-copies-of-detached)))) ; <- Do not add fixes after this one ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; COMPONENTS MIGRATION @@ -574,7 +897,7 @@ (if (> ext-idx 0) (subs filename 0 ext-idx) filename))) (defn- collect-and-persist-images - [svg-data file-id] + [svg-data file-id media-id] (letfn [(process-image [{:keys [href] :as item}] (try (let [item (if (str/starts-with? href "data:") @@ -601,12 +924,13 @@ ;; The media processing adds the data to the ;; input map and returns it. (media/run {:cmd :info :input item})) - - (catch Throwable cause - (l/warn :hint "unexpected exception on processing internal image shape (skiping)" - :cause cause) - (when-not *skip-on-error* - (throw cause))))) + (catch Throwable _ + (let [team-id *team-id*] + (l/wrn :hint "unable to process embedded images on svg file" + :team-id (str team-id) + :file-id (str file-id) + :media-id (str media-id))) + nil))) (persist-image [acc {:keys [path size width height mtype href] :as item}] (let [storage (::sto/storage *system*) @@ -642,23 +966,33 @@ (completing persist-image) {}))] (assoc svg-data :image-data images)))) -(defn- get-svg-content +(defn- resolve-sobject-id + [id] + (let [fmobject (db/get *system* :file-media-object {:id id} + {::sql/columns [:media-id]})] + (:media-id fmobject))) + +(defn- get-sobject-content [id] (let [storage (::sto/storage *system*) - conn (::db/conn *system*) - fmobject (db/get conn :file-media-object {:id id}) - sobject (sto/get-object storage (:media-id fmobject))] - + sobject (sto/get-object storage id)] (with-open [stream (sto/get-object-data storage sobject)] (slurp stream)))) (defn- create-shapes-for-svg [{:keys [id] :as mobj} file-id objects frame-id position] - (let [svg-text (get-svg-content id) - svg-text (svgo/optimize *system* svg-text) - svg-data (-> (csvg/parse svg-text) - (assoc :name (:name mobj)) - (collect-and-persist-images file-id))] + (let [get-svg (fn [sid] + (let [svg-text (get-sobject-content sid) + svg-text (svgo/optimize *system* svg-text)] + (-> (csvg/parse svg-text) + (assoc :name (:name mobj))))) + + sid (resolve-sobject-id id) + svg-data (if (cache/cache? *cache*) + (cache/get *cache* sid (px/wrap-bindings get-svg)) + (get-svg sid)) + + svg-data (collect-and-persist-images svg-data file-id id)] (sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false))) @@ -717,42 +1051,64 @@ (defn- create-media-grid [fdata page-id frame-id grid media-group] - (let [process (fn [mobj position] - (let [position (gpt/add position (gpt/point grid-gap grid-gap)) - tp1 (dt/tpoint)] - (try - (process-media-object fdata page-id frame-id mobj position) - (catch Throwable cause - (l/wrn :hint "unable to process file media object (skiping)" - :file-id (str (:id fdata)) - :id (str (:id mobj)) - :cause cause) - (if-not *skip-on-error* - (throw cause) - nil)) - (finally - (l/trc :hint "graphic processed" - :file-id (str (:id fdata)) - :media-id (str (:id mobj)) - :elapsed (dt/format-duration (tp1)))))))] + (letfn [(process [fdata mobj position] + (let [position (gpt/add position (gpt/point grid-gap grid-gap)) + tp (dt/tpoint) + err (volatile! false)] + (try + (let [changes (process-media-object fdata page-id frame-id mobj position)] + (cp/process-changes fdata changes false)) + + (catch Throwable cause + (vreset! err true) + (let [cause (pu/unwrap-exception cause) + edata (ex-data cause) + team-id *team-id*] + (cond + (instance? org.xml.sax.SAXParseException cause) + (l/inf :hint "skip processing media object: invalid svg found" + :team-id (str team-id) + :file-id (str (:id fdata)) + :id (str (:id mobj))) + + (instance? org.graalvm.polyglot.PolyglotException cause) + (l/inf :hint "skip processing media object: invalid svg found" + :team-id (str team-id) + :file-id (str (:id fdata)) + :id (str (:id mobj))) + + (= (:type edata) :not-found) + (l/inf :hint "skip processing media object: underlying object does not exist" + :team-id (str team-id) + :file-id (str (:id fdata)) + :id (str (:id mobj))) + + :else + (let [skip? *skip-on-graphic-error*] + (l/wrn :hint "unable to process file media object" + :skiped skip? + :team-id (str team-id) + :file-id (str (:id fdata)) + :id (str (:id mobj)) + :cause cause) + (when-not skip? + (throw cause)))) + nil)) + (finally + (let [elapsed (tp)] + (l/trc :hint "graphic processed" + :file-id (str (:id fdata)) + :media-id (str (:id mobj)) + :error @err + :elapsed (dt/format-duration elapsed)))))))] (->> (d/zip media-group grid) - (partition-all (or *max-procs* 1)) - (mapcat (fn [partition] - (->> partition - (map (fn [[mobj position]] - (sse/tap {:type :migration-progress - :section :graphics - :name (:name mobj)}) - (p/vthread (process mobj position)))) - (doall) - (map deref) - (doall)))) - (filter some?) - (reduce (fn [fdata changes] - (-> (assoc-in fdata [:options :components-v2] true) - (cp/process-changes changes false))) - fdata)))) + (reduce (fn [fdata [mobj position]] + (sse/tap {:type :migration-progress + :section :graphics + :name (:name mobj)}) + (or (process fdata mobj position) fdata)) + (assoc-in fdata [:options :components-v2] true))))) (defn- migrate-graphics [fdata] @@ -821,9 +1177,13 @@ (decode-row) (update :data assoc :id id) (update :data fdata/process-pointers deref) + (update :data fdata/process-objects (partial into {})) + (update :data (fn [data] + (if (> (:version data) 22) + (assoc data :version 22) + data))) (fmg/migrate-file)))) - (defn- get-team [system team-id] (-> (db/get system :team {:id team-id} @@ -832,17 +1192,12 @@ (decode-row))) (defn- validate-file! - [file libs throw-on-validate?] - (try - (cfv/validate-file! file libs) - (cfv/validate-file-schema! file) - (catch Throwable cause - (if throw-on-validate? - (throw cause) - (l/wrn :hint "migrate:file:validation-error" :cause cause))))) + [file libs] + (cfv/validate-file! file libs) + (cfv/validate-file-schema! file)) (defn- process-file - [{:keys [::db/conn] :as system} id & {:keys [validate? throw-on-validate?]}] + [{:keys [::db/conn] :as system} id & {:keys [validate?]}] (let [file (get-file system id) libs (->> (files/get-file-libraries conn id) @@ -855,7 +1210,7 @@ (update :features conj "components/v2")) _ (when validate? - (validate-file! file libs throw-on-validate?)) + (validate-file! file libs)) file (if (contains? (:features file) "fdata/objects-map") (fdata/enable-objects-map file) @@ -876,12 +1231,13 @@ (dissoc file :data))) - (def ^:private sql:get-and-lock-team-files "SELECT f.id 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 FOR UPDATE") (defn- get-and-lock-files @@ -901,21 +1257,33 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn migrate-file! - [system file-id & {:keys [validate? throw-on-validate? max-procs]}] - (let [tpoint (dt/tpoint)] + [system file-id & {:keys [validate? skip-on-graphic-error? label]}] + (let [tpoint (dt/tpoint)] (binding [*file-stats* (atom {}) - *max-procs* max-procs] + *skip-on-graphic-error* skip-on-graphic-error?] (try - (l/dbg :hint "migrate:file:start" :file-id (str file-id)) + (l/dbg :hint "migrate:file:start" + :file-id (str file-id) + :validate validate? + :skip-on-graphic-error skip-on-graphic-error?) (let [system (update system ::sto/storage media/configure-assets-storage)] (db/tx-run! system (fn [system] - (binding [*system* system] - (fsnap/take-file-snapshot! system {:file-id file-id :label "migration/components-v2"}) - (process-file system file-id - :validate? validate? - :throw-on-validate? throw-on-validate?))))) + (try + (binding [*system* system] + (when (string? label) + (fsnap/take-file-snapshot! system {:file-id file-id + :label (str "migration/" label)})) + (process-file system file-id :validate? validate?)) + + (catch Throwable cause + (let [team-id *team-id*] + (l/wrn :hint "error on processing file" + :team-id (str team-id) + :file-id (str file-id)) + (throw cause))))))) + (finally (let [elapsed (tpoint) components (get @*file-stats* :processed/components 0) @@ -925,46 +1293,52 @@ :file-id (str file-id) :graphics graphics :components components + :validate validate? :elapsed (dt/format-duration elapsed)) (some-> *stats* (swap! update :processed/files (fnil inc 0))) (some-> *team-stats* (swap! update :processed/files (fnil inc 0))))))))) (defn migrate-team! - [system team-id & {:keys [validate? throw-on-validate? max-procs]}] + [system team-id & {:keys [validate? skip-on-graphic-error? label]}] (l/dbg :hint "migrate:team:start" :team-id (dm/str team-id)) (let [tpoint (dt/tpoint) + err (volatile! false) migrate-file (fn [system file-id] (migrate-file! system file-id - :max-procs max-procs + :label label :validate? validate? - :throw-on-validate? throw-on-validate?)) + :skip-on-graphic-error? skip-on-graphic-error?)) migrate-team - (fn [{:keys [::db/conn] :as system} {:keys [id features] :as team}] - (let [features (-> features - (disj "ephimeral/v2-migration") - (conj "components/v2") - (conj "layout/grid") - (conj "styles/v2"))] + (fn [{:keys [::db/conn] :as system} team-id] + (let [{:keys [id features]} (get-team system team-id)] + (if (contains? features "components/v2") + (l/inf :hint "team already migrated") + (let [features (-> features + (disj "ephimeral/v2-migration") + (conj "components/v2") + (conj "layout/grid") + (conj "styles/v2"))] - (run! (partial migrate-file system) - (get-and-lock-files conn id)) + (run! (partial migrate-file system) + (get-and-lock-files conn id)) - (update-team-features! conn id features)))] + (update-team-features! conn id features)))))] - (binding [*team-stats* (atom {})] + (binding [*team-stats* (atom {}) + *team-id* team-id] (try - (db/tx-run! system (fn [system] - (db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"]) - (let [team (get-team system team-id)] - (if (contains? (:features team) "components/v2") - (l/inf :hint "team already migrated") - (migrate-team system team))))) + (db/tx-run! system migrate-team team-id) + + (catch Throwable cause + (vreset! err true) + (throw cause)) + (finally (let [elapsed (tpoint) components (get @*team-stats* :processed/components 0) @@ -973,9 +1347,21 @@ (some-> *stats* (swap! update :processed/teams (fnil inc 0))) - (l/dbg :hint "migrate:team:end" - :team-id (dm/str team-id) - :files files - :components components - :graphics graphics - :elapsed (dt/format-duration elapsed)))))))) + (if (cache/cache? *cache*) + (let [cache-stats (cache/stats *cache*)] + (l/dbg :hint "migrate:team:end" + :team-id (dm/str team-id) + :files files + :components components + :graphics graphics + :crt (mth/to-fixed (:hit-rate cache-stats) 2) + :crq (str (:req-count cache-stats)) + :error @err + :elapsed (dt/format-duration elapsed))) + + (l/dbg :hint "migrate:team:end" + :team-id (dm/str team-id) + :files files + :components components + :graphics graphics + :elapsed (dt/format-duration elapsed))))))))) diff --git a/backend/src/app/features/fdata.clj b/backend/src/app/features/fdata.clj index 68e58833cd..8a57a1aa17 100644 --- a/backend/src/app/features/fdata.clj +++ b/backend/src/app/features/fdata.clj @@ -27,7 +27,7 @@ (update :data (fn [fdata] (-> fdata (update :pages-index update-vals update-fn) - (update :components update-vals update-fn)))) + (d/update-when :components update-vals update-fn)))) (update :features conj "fdata/objects-map")))) (defn process-objects @@ -110,6 +110,6 @@ (update :data (fn [fdata] (-> fdata (update :pages-index update-vals pmap/wrap) - (update :components pmap/wrap)))) + (d/update-when :components pmap/wrap)))) (update :features conj "fdata/pointer-map"))) diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index c80210a06b..7028be8bfe 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -301,7 +301,8 @@ ::sto/storage (ig/ref ::sto/storage)} :app.rpc/climit - {::mtx/metrics (ig/ref ::mtx/metrics)} + {::mtx/metrics (ig/ref ::mtx/metrics) + ::wrk/executor (ig/ref ::wrk/executor)} :app.rpc/rlimit {::wrk/executor (ig/ref ::wrk/executor)} @@ -410,8 +411,7 @@ ::migrations (ig/ref :app.migrations/migrations)} ::svgo/optimizer - {::wrk/executor (ig/ref ::wrk/executor) - ::svgo/max-procs (cf/get :svgo-max-procs)} + {} ::audit.tasks/archive {::props (ig/ref ::setup/props) diff --git a/backend/src/app/redis.clj b/backend/src/app/redis.clj index b730ab1063..58023fe00e 100644 --- a/backend/src/app/redis.clj +++ b/backend/src/app/redis.clj @@ -91,7 +91,7 @@ (s/def ::connect? ::us/boolean) (s/def ::io-threads ::us/integer) (s/def ::worker-threads ::us/integer) -(s/def ::cache some?) +(s/def ::cache cache/cache?) (s/def ::redis (s/keys :req [::resources @@ -168,7 +168,7 @@ (defn- shutdown-resources [{:keys [::resources ::cache ::timer]}] - (cache/invalidate-all! cache) + (cache/invalidate! cache) (when resources (.shutdown ^ClientResources resources)) @@ -211,7 +211,8 @@ (defn get-or-connect [{:keys [::cache] :as state} key options] (us/assert! ::redis state) - (let [connection (cache/get cache key (fn [_] (connect* state options)))] + (let [create (fn [_] (connect* state options)) + connection (cache/get cache key create)] (-> state (dissoc ::cache) (assoc ::connection connection)))) diff --git a/backend/src/app/rpc/climit.clj b/backend/src/app/rpc/climit.clj index d6e4ccb51b..71c64b596a 100644 --- a/backend/src/app/rpc/climit.clj +++ b/backend/src/app/rpc/climit.clj @@ -36,24 +36,14 @@ (-> (str id) (subs 1))) -(defn- create-bulkhead-cache - [config] - (letfn [(load-fn [[id skey]] - (when-let [config (get config id)] - (l/trc :hint "insert into cache" :id (id->str id) :key skey) - (pbh/create :permits (or (:permits config) (:concurrency config)) - :queue (or (:queue config) (:queue-size config)) - :timeout (:timeout config) - :type :semaphore))) - - (on-remove [key _ cause] +(defn- create-cache + [{:keys [::wrk/executor]}] + (letfn [(on-remove [key _ cause] (let [[id skey] key] - (l/trc :hint "evict from cache" :id (id->str id) :key skey :reason (str cause))))] - - (cache/create :executor :same-thread + (l/dbg :hint "destroy limiter" :id (id->str id) :key skey :reason (str cause))))] + (cache/create :executor executor :on-remove on-remove - :keepalive "5m" - :load-fn load-fn))) + :keepalive "5m"))) (s/def ::config/permits ::us/integer) (s/def ::config/queue ::us/integer) @@ -70,7 +60,7 @@ (s/def ::path ::fs/path) (defmethod ig/pre-init-spec ::rpc/climit [_] - (s/keys :req [::mtx/metrics ::path])) + (s/keys :req [::mtx/metrics ::wrk/executor ::path])) (defmethod ig/init-key ::rpc/climit [_ {:keys [::path ::mtx/metrics] :as cfg}] @@ -78,7 +68,7 @@ (when-let [params (some->> path slurp edn/read-string)] (l/inf :hint "initializing concurrency limit" :config (str path)) (us/verify! ::config params) - {::cache (create-bulkhead-cache params) + {::cache (create-cache cfg) ::config params ::mtx/metrics metrics}))) @@ -89,13 +79,17 @@ (s/def ::rpc/climit (s/nilable ::instance)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; PUBLIC API -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn- create-limiter + [config [id skey]] + (l/dbg :hint "create limiter" :id (id->str id) :key skey) + (pbh/create :permits (or (:permits config) (:concurrency config)) + :queue (or (:queue config) (:queue-size config)) + :timeout (:timeout config) + :type :semaphore)) -(defn invoke! - [cache metrics id key f] - (if-let [limiter (cache/get cache [id key])] +(defn- invoke! + [config cache metrics id key f] + (if-let [limiter (cache/get cache [id key] (partial create-limiter config))] (let [tpoint (dt/tpoint) labels (into-array String [(id->str id)]) wrapped (fn [] @@ -147,7 +141,7 @@ :queue (:queue stats) :max-permits (:max-permits stats) :max-queue (:max-queue stats)) - (pbh/invoke! limiter wrapped)) + (px/invoke! limiter wrapped)) (catch ExceptionInfo cause (let [{:keys [type code]} (ex-data cause)] (if (= :bulkhead-error type) @@ -160,9 +154,43 @@ (measure! (pbh/get-stats limiter))))) (do - (l/wrn :hint "unable to load limiter" :id (id->str id)) + (l/wrn :hint "no limiter found" :id (id->str id)) (f)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; MIDDLEWARE +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def noop-fn (constantly nil)) + +(defn wrap + [{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}] + (if (and (some? climit) (some? id)) + (let [cache (::cache climit) + config (::config climit)] + (if-let [config (get config id)] + (do + (l/dbg :hint "instrumenting method" + :limit (id->str id) + :service-name (::sv/name mdata) + :timeout (:timeout config) + :permits (:permits config) + :queue (:queue config) + :keyed? (not= key-fn noop-fn)) + + (fn [cfg params] + (invoke! config cache metrics id (key-fn params) (partial f cfg params)))) + + (do + (l/wrn :hint "no config found for specified queue" :id (id->str id)) + f))) + + f)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PUBLIC API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defn configure [{:keys [::rpc/climit]} id] (us/assert! ::rpc/climit climit) @@ -171,37 +199,14 @@ (defn run! "Run a function in context of climit. Intended to be used in virtual threads." - ([{:keys [::id ::cache ::mtx/metrics]} f] - (if (and cache id) - (invoke! cache metrics id nil f) + ([{:keys [::id ::cache ::config ::mtx/metrics]} f] + (if-let [config (get config id)] + (invoke! config cache metrics id nil f) (f))) - ([{:keys [::id ::cache ::mtx/metrics]} f executor] + ([{:keys [::id ::cache ::config ::mtx/metrics]} f executor] (let [f #(p/await! (px/submit! executor f))] - (if (and cache id) - (invoke! cache metrics id nil f) + (if-let [config (get config id)] + (invoke! config cache metrics id nil f) (f))))) -(def noop-fn (constantly nil)) - -(defn wrap - [{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}] - (if (and (some? climit) (some? id)) - (if-let [config (get-in climit [::config id])] - (let [cache (::cache climit)] - (l/dbg :hint "instrumenting method" - :limit (id->str id) - :service-name (::sv/name mdata) - :timeout (:timeout config) - :permits (:permits config) - :queue (:queue config) - :keyed? (not= key-fn noop-fn)) - - (fn [cfg params] - (invoke! cache metrics id (key-fn params) (partial f cfg params)))) - - (do - (l/wrn :hint "no config found for specified queue" :id (id->str id)) - f)) - - f)) diff --git a/backend/src/app/rpc/commands/binfile.clj b/backend/src/app/rpc/commands/binfile.clj index 81bb6e10a7..ebebbc42f8 100644 --- a/backend/src/app/rpc/commands/binfile.clj +++ b/backend/src/app/rpc/commands/binfile.clj @@ -664,9 +664,7 @@ (case feature "components/v2" (feat.compv2/migrate-file! options file-id - :max-procs 2 - :validate? validate? - :throw-on-validate? true) + :validate? validate?) "fdata/shape-data-type" nil diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index f6b6c615da..f2e6a19899 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -226,23 +226,37 @@ [{:keys [::db/conn] :as cfg} {:keys [id] :as file}] (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id) pmap/*tracked* (pmap/create-tracked)] - (let [file (fmg/migrate-file file)] + (let [;; For avoid unnecesary overhead of creating multiple pointers and + ;; handly internally with objects map in their worst case (when + ;; probably all shapes and all pointers will be readed in any + ;; case), we just realize/resolve them before applying the + ;; migration to the file + file (-> file + (update :data feat.fdata/process-pointers deref) + (update :data feat.fdata/process-objects (partial into {})) + (fmg/migrate-file)) - ;; NOTE: when file is migrated, we break the rule of no perform - ;; mutations on get operations and update the file with all - ;; migrations applied - ;; - ;; NOTE: the following code will not work on read-only mode, it - ;; is a known issue; we keep is not implemented until we really - ;; need this - (when (fmg/migrated? file) - (db/update! conn :file - {:data (blob/encode (:data file)) - :features (db/create-array conn "text" (:features file))} - {:id id}) + ;; When file is migrated, we break the rule of no perform + ;; mutations on get operations and update the file with all + ;; migrations applied + ;; + ;; WARN: he following code will not work on read-only mode, + ;; it is a known issue; we keep is not implemented until we + ;; really need this. + file (if (contains? (:features file) "fdata/objects-map") + (feat.fdata/enable-objects-map file) + file) + file (if (contains? (:features file) "fdata/pointer-map") + (feat.fdata/enable-pointer-map file) + file)] - (when (contains? (:features file) "fdata/pointer-map") - (feat.fdata/persist-pointers! cfg id))) + (db/update! conn :file + {:data (blob/encode (:data file)) + :features (db/create-array conn "text" (:features file))} + {:id id}) + + (when (contains? (:features file) "fdata/pointer-map") + (feat.fdata/persist-pointers! cfg id)) file))) @@ -266,7 +280,7 @@ ::db/remove-deleted (not include-deleted?) ::sql/for-update lock-for-update?}) (decode-row))] - (if migrate? + (if (and migrate? (fmg/need-migration? file)) (migrate-file cfg file) file))) diff --git a/backend/src/app/rpc/commands/files_create.clj b/backend/src/app/rpc/commands/files_create.clj index 59273f033e..dbbd1c04d1 100644 --- a/backend/src/app/rpc/commands/files_create.clj +++ b/backend/src/app/rpc/commands/files_create.clj @@ -18,14 +18,12 @@ [app.loggers.audit :as-alias audit] [app.loggers.webhooks :as-alias webhooks] [app.rpc :as-alias rpc] - [app.rpc.commands.files :as files] [app.rpc.commands.projects :as projects] [app.rpc.commands.teams :as teams] [app.rpc.doc :as-alias doc] [app.rpc.permissions :as perms] [app.rpc.quotes :as quotes] [app.util.blob :as blob] - [app.util.objects-map :as omap] [app.util.pointer-map :as pmap] [app.util.services :as sv] [app.util.time :as dt] @@ -50,47 +48,52 @@ "expected a valid connection" (db/connection? conn)) - (let [id (or id (uuid/next)) + (binding [pmap/*tracked* (pmap/create-tracked) + cfeat/*current* features] + (let [id (or id (uuid/next)) - pointers (pmap/create-tracked) - pmap? (contains? features "fdata/pointer-map") - omap? (contains? features "fdata/objects-map") - - data (binding [pmap/*tracked* pointers - cfeat/*current* features - cfeat/*wrap-with-objects-map-fn* (if omap? omap/wrap identity) - cfeat/*wrap-with-pointer-map-fn* (if pmap? pmap/wrap identity)] - (if create-page + data (if create-page (ctf/make-file-data id) - (ctf/make-file-data id nil))) + (ctf/make-file-data id nil)) - features (->> (set/difference features cfeat/frontend-only-features) - (db/create-array conn "text")) + file {:id id + :project-id project-id + :name name + :revn revn + :is-shared is-shared + :data data + :features features + :ignore-sync-until ignore-sync-until + :modified-at modified-at + :deleted-at deleted-at} - file (db/insert! conn :file - (d/without-nils - {:id id - :project-id project-id - :name name - :revn revn - :is-shared is-shared - :data (blob/encode data) - :features features - :ignore-sync-until ignore-sync-until - :modified-at modified-at - :deleted-at deleted-at}))] + file (if (contains? features "fdata/objects-map") + (feat.fdata/enable-objects-map file) + file) - (binding [pmap/*tracked* pointers] - (feat.fdata/persist-pointers! cfg id)) + file (if (contains? features "fdata/pointer-map") + (feat.fdata/enable-pointer-map file) + file) - (->> (assoc params :file-id id :role :owner) - (create-file-role! conn)) + file (d/without-nils file)] - (db/update! conn :project - {:modified-at (dt/now)} - {:id project-id}) + (db/insert! conn :file + (-> file + (update :data blob/encode) + (update :features db/encode-pgarray conn "text")) + {::db/return-keys false}) - (files/decode-row file))) + (when (contains? features "fdata/pointer-map") + (feat.fdata/persist-pointers! cfg id)) + + (->> (assoc params :file-id id :role :owner) + (create-file-role! conn)) + + (db/update! conn :project + {:modified-at (dt/now)} + {:id project-id}) + + file))) (def ^:private schema:create-file [:map {:title "create-file"} diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 03e1b04da4..134a127946 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -292,9 +292,20 @@ (let [file (update file :data (fn [data] (-> data (blob/decode) - (assoc :id (:id file)) - (fmg/migrate-data) - (d/without-nils)))) + (assoc :id (:id file))))) + + ;; For avoid unnecesary overhead of creating multiple pointers + ;; and handly internally with objects map in their worst + ;; case (when probably all shapes and all pointers will be + ;; readed in any case), we just realize/resolve them before + ;; applying the migration to the file + file (if (fmg/need-migration? file) + (-> file + (update :data feat.fdata/process-pointers deref) + (update :data feat.fdata/process-objects (partial into {})) + (fmg/migrate-file)) + file) + ;; WARNING: this ruins performance; maybe we need to find ;; some other way to do general validation @@ -305,14 +316,20 @@ (into [file] (map (fn [{:keys [id]}] (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id) pmap/*tracked* nil] + ;; We do not resolve the objects maps here + ;; because there is a lower probability that all + ;; shapes needed to be loded into memory, so we + ;; leeave it on lazy status (-> (files/get-file cfg id :migrate? false) (update :data feat.fdata/process-pointers deref) ; ensure all pointers resolved (fmg/migrate-file)))))) (d/index-by :id))) + file (-> (files/check-version! file) (update :revn inc) - (update :data cpc/process-changes changes))] + (update :data cpc/process-changes changes) + (update :data d/without-nils))] (when (contains? cf/flags :soft-file-validation) (soft-validate-file! file libs)) @@ -329,12 +346,10 @@ (val/validate-file-schema! file)) (cond-> file - (and (contains? cfeat/*current* "fdata/objects-map") - (not (contains? cfeat/*previous* "fdata/objects-map"))) + (contains? cfeat/*current* "fdata/objects-map") (feat.fdata/enable-objects-map) - (and (contains? cfeat/*current* "fdata/pointer-map") - (not (contains? cfeat/*previous* "fdata/pointer-map"))) + (contains? cfeat/*current* "fdata/pointer-map") (feat.fdata/enable-pointer-map) :always diff --git a/backend/src/app/srepl/components_v2.clj b/backend/src/app/srepl/components_v2.clj index fec852f082..5e6a697bb7 100644 --- a/backend/src/app/srepl/components_v2.clj +++ b/backend/src/app/srepl/components_v2.clj @@ -6,13 +6,18 @@ (ns app.srepl.components-v2 (:require + [app.common.data :as d] [app.common.logging :as l] [app.common.pprint :as pp] + [app.common.uuid :as uuid] [app.db :as db] [app.features.components-v2 :as feat] + [app.main :as main] + [app.svgo :as svgo] + [app.util.cache :as cache] [app.util.time :as dt] + [app.worker :as-alias wrk] [cuerdas.core :as str] - [promesa.core :as p] [promesa.exec :as px] [promesa.exec.semaphore :as ps] [promesa.util :as pu])) @@ -35,14 +40,9 @@ (fn [_ _ oldv newv] (when (not= (:processed/files oldv) (:processed/files newv)) - (let [total (:total/files newv) - completed (:processed/files newv) - progress (/ (* completed 100.0) total) - elapsed (tpoint)] + (let [elapsed (tpoint)] (l/dbg :hint "progress" :completed (:processed/files newv) - :total (:total/files newv) - :progress (str (int progress) "%") :elapsed (dt/format-duration elapsed)))))) (defn- report-progress-teams @@ -50,88 +50,147 @@ (fn [_ _ oldv newv] (when (not= (:processed/teams oldv) (:processed/teams newv)) - (let [total (:total/teams newv) - completed (:processed/teams newv) - progress (/ (* completed 100.0) total) - progress (str (int progress) "%") + (let [completed (:processed/teams newv) elapsed (dt/format-duration (tpoint))] - (when (fn? on-progress) - (on-progress {:total total - :elapsed elapsed - :completed completed - :progress progress})) - + (on-progress {:elapsed elapsed + :completed completed})) (l/dbg :hint "progress" :completed completed - :progress progress :elapsed elapsed))))) -(defn- get-total-files - [pool & {:keys [team-id]}] - (if (some? team-id) - (let [sql (str/concat - "SELECT count(f.id) AS count FROM file AS f " - " JOIN project AS p ON (p.id = f.project_id) " - " WHERE p.team_id = ? AND f.deleted_at IS NULL " - " AND p.deleted_at IS NULL") - res (db/exec-one! pool [sql team-id])] - (:count res)) +(def ^:private sql:get-teams-by-created-at + "WITH teams AS ( + SELECT id, features + FROM team + WHERE deleted_at IS NULL + ORDER BY created_at DESC + ) SELECT * FROM TEAMS %(pred)s") - (let [sql (str/concat - "SELECT count(id) AS count FROM file " - " WHERE deleted_at IS NULL") - res (db/exec-one! pool [sql])] - (:count res)))) +(def ^:private sql:get-teams-by-graphics + "WITH teams AS ( + SELECT t.id, t.features, + (SELECT count(*) + FROM file_media_object AS fmo + JOIN file AS f ON (f.id = fmo.file_id) + JOIN project AS p ON (p.id = f.project_id) + WHERE p.team_id = t.id + AND fmo.mtype = 'image/svg+xml' + AND fmo.is_local = false) AS graphics + FROM team AS t + WHERE t.deleted_at IS NULL + ORDER BY 3 ASC + ) + SELECT * FROM teams %(pred)s") -(defn- get-total-teams - [pool] - (let [sql (str/concat - "SELECT count(id) AS count FROM team " - " WHERE deleted_at IS NULL") - res (db/exec-one! pool [sql])] - (:count res))) +(def ^:private sql:get-teams-by-activity + "WITH teams AS ( + SELECT t.id, t.features, + (SELECT coalesce(max(date_trunc('month', f.modified_at)), date_trunc('month', t.modified_at)) + FROM file AS f + JOIN project AS p ON (f.project_id = p.id) + WHERE p.team_id = t.id) AS updated_at, + (SELECT coalesce(count(*), 0) + FROM file AS f + JOIN project AS p ON (f.project_id = p.id) + WHERE p.team_id = t.id) AS total_files + FROM team AS t + WHERE t.deleted_at IS NULL + ORDER BY 3 DESC, 4 DESC + ) + SELECT * FROM teams %(pred)s") +(def ^:private sql:get-teams-by-report + "WITH teams AS ( + SELECT t.id t.features, mr.name + FROM migration_report AS mr + JOIN team AS t ON (t.id = mr.team_id) + WHERE t.deleted_at IS NULL + AND mr.error IS NOT NULL + ORDER BY mr.created_at + ) SELECT id, features FROM teams %(pred)s") -(defn- mark-team-migration! - [{:keys [::db/pool]} team-id] - ;; We execute this out of transaction because we want this - ;; change to be visible to all other sessions before starting - ;; the migration - (let [sql (str "UPDATE team SET features = " - " array_append(features, 'ephimeral/v2-migration') " - " WHERE id = ?")] - (db/exec-one! pool [sql team-id]))) +(defn- read-pred + [entries] + (let [entries (if (and (vector? entries) + (keyword? (first entries))) + [entries] + entries)] + (loop [params [] + queries [] + entries (seq entries)] + (if-let [[op val field] (first entries)] + (let [field (name field) + cond (case op + :lt (str/ffmt "% < ?" field) + :lte (str/ffmt "% <= ?" field) + :gt (str/ffmt "% > ?" field) + :gte (str/ffmt "% >= ?" field) + :eq (str/ffmt "% = ?" field))] + (recur (conj params val) + (conj queries cond) + (rest entries))) -(defn- unmark-team-migration! - [{:keys [::db/pool]} team-id] - ;; We execute this out of transaction because we want this - ;; change to be visible to all other sessions before starting - ;; the migration - (let [sql (str "UPDATE team SET features = " - " array_remove(features, 'ephimeral/v2-migration') " - " WHERE id = ?")] - (db/exec-one! pool [sql team-id]))) - -(def ^:private sql:get-teams - "SELECT id, features - FROM team - WHERE deleted_at IS NULL - ORDER BY created_at ASC") + (let [sql (apply str "WHERE " (str/join " AND " queries))] + (apply vector sql params)))))) (defn- get-teams - [conn] - (->> (db/cursor conn sql:get-teams) - (map feat/decode-row))) + [conn query pred] + (let [query (d/nilv query :created-at) + sql (case query + :created-at sql:get-teams-by-created-at + :activity sql:get-teams-by-activity + :graphics sql:get-teams-by-graphics + :report sql:get-teams-by-report) + + sql (if pred + (let [[pred-sql & pred-params] (read-pred pred)] + (apply vector + (str/format sql {:pred pred-sql}) + pred-params)) + [(str/format sql {:pred ""})])] + + (->> (db/cursor conn sql {:chunk-size 500}) + (map feat/decode-row) + (remove (fn [{:keys [features]}] + (contains? features "components/v2"))) + (map :id)))) + +(def ^:private sql:report-table + "CREATE UNLOGGED TABLE IF NOT EXISTS migration_report ( + id bigserial NOT NULL, + label text NOT NULL, + team_id UUID NOT NULL, + error text NULL, + created_at timestamptz NOT NULL DEFAULT now(), + elapsed bigint NOT NULL, + PRIMARY KEY (label, created_at, id) + )") + +(defn- create-report-table! + [system] + (db/exec-one! system [sql:report-table])) + +(defn- clean-reports! + [system label] + (db/delete! system :migration-report {:label label})) + +(defn- report! + [system team-id label elapsed error] + (db/insert! system :migration-report + {:label label + :team-id team-id + :elapsed (inst-ms elapsed) + :error error} + {::db/return-keys false})) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PUBLIC API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn migrate-file! - [system file-id & {:keys [rollback? max-procs] - :or {rollback? true}}] - + [file-id & {:keys [rollback? validate? label] :or {rollback? true validate? false}}] (l/dbg :hint "migrate:start" :rollback rollback?) (let [tpoint (dt/tpoint) file-id (if (string? file-id) @@ -139,8 +198,10 @@ file-id)] (binding [feat/*stats* (atom {})] (try - (-> (assoc system ::db/rollback rollback?) - (feat/migrate-file! file-id :max-procs max-procs)) + (-> (assoc main/system ::db/rollback rollback?) + (feat/migrate-file! file-id + :validate? validate? + :label label)) (-> (deref feat/*stats*) (assoc :elapsed (dt/format-duration (tpoint)))) @@ -153,47 +214,36 @@ (l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed))))))) (defn migrate-team! - [{:keys [::db/pool] :as system} team-id & {:keys [rollback? skip-on-error validate? max-procs] - :or {rollback? true - skip-on-error true - validate? false - max-procs 1} - :as opts}] + [team-id & {:keys [rollback? skip-on-graphic-error? validate? label] + :or {rollback? true + validate? true + skip-on-graphic-error? false}}] (l/dbg :hint "migrate:start" :rollback rollback?) (let [team-id (if (string? team-id) (parse-uuid team-id) team-id) - total (get-total-files pool :team-id team-id) - stats (atom {:total/files total}) + stats (atom {}) tpoint (dt/tpoint)] (add-watch stats :progress-report (report-progress-files tpoint)) - (binding [feat/*stats* stats - feat/*skip-on-error* skip-on-error] - + (binding [feat/*stats* stats] (try - (mark-team-migration! system team-id) - - (-> (assoc system ::db/rollback rollback?) + (-> (assoc main/system ::db/rollback rollback?) (feat/migrate-team! team-id - :max-procs max-procs + :label label :validate? validate? - :throw-on-validate? (not skip-on-error))) - + :skip-on-graphic-error? skip-on-graphic-error?)) (print-stats! (-> (deref feat/*stats*) - (dissoc :total/files) (assoc :elapsed (dt/format-duration (tpoint))))) (catch Throwable cause (l/dbg :hint "migrate:error" :cause cause)) (finally - (unmark-team-migration! system team-id) - (let [elapsed (dt/format-duration (tpoint))] (l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed))))))) @@ -204,98 +254,118 @@ until thw maximum number of jobs is reached which by default has the value of `1`. This is controled with the `:max-jobs` option. - Each tram migration process also can start multiple procs for - graphics migration, the total of that procs is controled with the - `:max-procs` option. + If you want to run this on multiple machines you will need to specify + the total number of partitions and the current partition. - Internally, the graphics migration process uses SVGO module which by - default has a limited number of maximum concurent - operations (globally), ensure setting up correct number with - PENPOT_SVGO_MAX_PROCS environment variable." + In order to get the report table populated, you will need to provide + a correct `:label`. That label is also used for persist a file + snaphot before continue with the migration." + [& {:keys [max-jobs max-items max-time rollback? validate? query + pred max-procs cache on-start on-progress on-error on-end + skip-on-graphic-error? label partitions current-partition] + :or {validate? false + rollback? true + max-jobs 1 + current-partition 1 + skip-on-graphic-error? true + max-items Long/MAX_VALUE}}] - [{:keys [::db/pool] :as system} & {:keys [max-jobs max-procs max-items - rollback? validate? preset - skip-on-error max-time - on-start on-progress on-error on-end] - :or {validate? false - rollback? true - skip-on-error true - preset :shutdown-on-failure - max-jobs 1 - max-procs 10 - max-items Long/MAX_VALUE} - :as opts}] + (when (int? partitions) + (when-not (int? current-partition) + (throw (IllegalArgumentException. "missing `current-partition` parameter"))) + (when-not (<= 0 current-partition partitions) + (throw (IllegalArgumentException. "invalid value on `current-partition` parameter")))) - (let [total (get-total-teams pool) - stats (atom {:total/teams (min total max-items)}) + (let [stats (atom {}) + tpoint (dt/tpoint) + mtime (some-> max-time dt/duration) - tpoint (dt/tpoint) - mtime (some-> max-time dt/duration) + factory (px/thread-factory :virtual false :prefix "penpot/migration/") + executor (px/cached-executor :factory factory) - scope (px/structured-task-scope :preset preset :factory :virtual) - sjobs (ps/create :permits max-jobs) + max-procs (or max-procs max-jobs) + sjobs (ps/create :permits max-jobs) + sprocs (ps/create :permits max-procs) + cache (if (int? cache) + (cache/create :executor executor + :max-items cache) + nil) migrate-team - (fn [{:keys [id features] :as team}] + (fn [team-id] + (let [tpoint (dt/tpoint)] + (try + (db/tx-run! (assoc main/system ::db/rollback rollback?) + (fn [system] + (db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"]) + (feat/migrate-team! system team-id + :label label + :validate? validate? + :skip-on-graphic-error? skip-on-graphic-error?))) + + (when (string? label) + (report! main/system team-id label (tpoint) nil)) + + (catch Throwable cause + (l/wrn :hint "unexpected error on processing team (skiping)" + :team-id (str team-id) + :cause cause) + (when (string? label) + (report! main/system team-id label (tpoint) (ex-message cause)))) + + (finally + (ps/release! sjobs))))) + + process-team + (fn [team-id] (ps/acquire! sjobs) (let [ts (tpoint)] - (cond - (and mtime (neg? (compare mtime ts))) + (if (and mtime (neg? (compare mtime ts))) (do (l/inf :hint "max time constraint reached" - :team-id (str id) + :team-id (str team-id) :elapsed (dt/format-duration ts)) (ps/release! sjobs) (reduced nil)) - (or (contains? features "ephimeral/v2-migration") - (contains? features "components/v2")) - (do - (l/dbg :hint "skip team" :team-id (str id)) - (ps/release! sjobs)) - - :else - (px/submit! scope (fn [] - (try - (mark-team-migration! system id) - (-> (assoc system ::db/rollback rollback?) - (feat/migrate-team! id - :max-procs max-procs - :validate? validate? - :throw-on-validate? (not skip-on-error))) - (catch Throwable cause - (l/err :hint "unexpected error on processing team" - :team-id (str id) - :cause cause)) - (finally - (ps/release! sjobs) - (unmark-team-migration! system id))))))))] + (px/run! executor (partial migrate-team team-id)))))] (l/dbg :hint "migrate:start" + :label label :rollback rollback? - :total total :max-jobs max-jobs - :max-procs max-procs :max-items max-items) (add-watch stats :progress-report (report-progress-teams tpoint on-progress)) (binding [feat/*stats* stats - feat/*skip-on-error* skip-on-error] + feat/*cache* cache + svgo/*semaphore* sprocs] (try (when (fn? on-start) - (on-start {:total total :rollback rollback?})) + (on-start {:rollback rollback?})) - (db/tx-run! system - (fn [{:keys [::db/conn]}] - (run! (partial migrate-team) - (->> (get-teams conn) - (take max-items))))) - (try - (p/await! scope) - (finally - (pu/close! scope))) + (when (string? label) + (create-report-table! main/system) + (clean-reports! main/system label)) + (db/tx-run! main/system + (fn [{:keys [::db/conn] :as system}] + (db/exec! conn ["SET statement_timeout = 0"]) + (db/exec! conn ["SET idle_in_transaction_session_timeout = 0"]) + + (run! process-team + (->> (get-teams conn query pred) + (filter (fn [team-id] + (if (int? partitions) + (= current-partition (-> (uuid/hash-int team-id) + (mod partitions) + (inc))) + true))) + (take max-items))) + + ;; Close and await tasks + (pu/close! executor))) (if (fn? on-end) (-> (deref stats) diff --git a/backend/src/app/srepl/helpers.clj b/backend/src/app/srepl/helpers.clj index f1a267e48d..5e2a26ee96 100644 --- a/backend/src/app/srepl/helpers.clj +++ b/backend/src/app/srepl/helpers.clj @@ -69,7 +69,8 @@ (fn [system] (binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)] (-> (files/get-file system id :migrate? migrate?) - (update :data feat.fdata/process-pointers deref)))))) + (update :data feat.fdata/process-pointers deref) + (update :data feat.fdata/process-objects (partial into {}))))))) (defn validate "Validate structure, referencial integrity and semantic coherence of diff --git a/backend/src/app/storage/s3.clj b/backend/src/app/storage/s3.clj index e019ad2676..1bbb38b16a 100644 --- a/backend/src/app/storage/s3.clj +++ b/backend/src/app/storage/s3.clj @@ -51,6 +51,7 @@ software.amazon.awssdk.services.s3.model.DeleteObjectsRequest software.amazon.awssdk.services.s3.model.DeleteObjectsResponse software.amazon.awssdk.services.s3.model.GetObjectRequest + software.amazon.awssdk.services.s3.model.NoSuchKeyException software.amazon.awssdk.services.s3.model.ObjectIdentifier software.amazon.awssdk.services.s3.model.PutObjectRequest software.amazon.awssdk.services.s3.model.S3Error @@ -126,17 +127,19 @@ (defmethod impl/get-object-data :s3 [backend object] (us/assert! ::backend backend) - (letfn [(no-such-key? [cause] - (instance? software.amazon.awssdk.services.s3.model.NoSuchKeyException cause)) - (handle-not-found [cause] - (ex/raise :type :not-found - :code :object-not-found - :hint "s3 object not found" - :cause cause))] - (-> (get-object-data backend object) - (p/catch no-such-key? handle-not-found) - (p/await!)))) + (let [result (p/await (get-object-data backend object))] + (if (ex/exception? result) + (cond + (ex/instance? NoSuchKeyException result) + (ex/raise :type :not-found + :code :object-not-found + :hint "s3 object not found" + :cause result) + :else + (throw result)) + + result))) (defmethod impl/get-object-bytes :s3 [backend object] @@ -298,7 +301,7 @@ [path] (proxy [FilterInputStream] [(io/input-stream path)] (close [] - (fs/delete path) + (ex/ignoring (fs/delete path)) (proxy-super close)))) (defn- get-object-data diff --git a/backend/src/app/svgo.clj b/backend/src/app/svgo.clj index 70d7c6b2b3..a846fa7680 100644 --- a/backend/src/app/svgo.clj +++ b/backend/src/app/svgo.clj @@ -7,16 +7,10 @@ (ns app.svgo "A SVG Optimizer service" (:require - [app.common.data :as d] - [app.common.data.macros :as dm] [app.common.jsrt :as jsrt] [app.common.logging :as l] - [app.common.spec :as us] [app.worker :as-alias wrk] - [clojure.spec.alpha :as s] [integrant.core :as ig] - [promesa.exec :as px] - [promesa.exec.bulkhead :as bh] [promesa.exec.semaphore :as ps] [promesa.util :as pu])) @@ -26,40 +20,23 @@ nil) (defn optimize - [system data] - (dm/assert! "expect data to be a string" (string? data)) - - (letfn [(optimize-fn [pool] - (jsrt/run! pool - (fn [context] - (jsrt/set! context "svgData" data) - (jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})"))))] - (try - (some-> *semaphore* ps/acquire!) - (let [{:keys [::jsrt/pool ::wrk/executor]} (::optimizer system)] - (dm/assert! "expect optimizer instance" (jsrt/pool? pool)) - (px/invoke! executor (partial optimize-fn pool))) - (finally - (some-> *semaphore* ps/release!))))) - -(s/def ::max-procs (s/nilable ::us/integer)) - -(defmethod ig/pre-init-spec ::optimizer [_] - (s/keys :req [::wrk/executor ::max-procs])) - -(defmethod ig/prep-key ::optimizer - [_ cfg] - (merge {::max-procs 20} (d/without-nils cfg))) + [{pool ::optimizer} data] + (try + (some-> *semaphore* ps/acquire!) + (jsrt/run! pool + (fn [context] + (jsrt/set! context "svgData" data) + (jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})"))) + (finally + (some-> *semaphore* ps/release!)))) (defmethod ig/init-key ::optimizer - [_ {:keys [::wrk/executor ::max-procs]}] - (l/inf :hint "initializing svg optimizer pool" :max-procs max-procs) - (let [init (jsrt/resource->source "app/common/svg/optimizer.js") - executor (bh/create :type :executor :executor executor :permits max-procs)] - {::jsrt/pool (jsrt/pool :init init) - ::wrk/executor executor})) + [_ _] + (l/inf :hint "initializing svg optimizer pool") + (let [init (jsrt/resource->source "app/common/svg/optimizer.js")] + (jsrt/pool :init init))) (defmethod ig/halt-key! ::optimizer - [_ {:keys [::jsrt/pool]}] + [_ pool] (l/info :hint "stopping svg optimizer pool") (pu/close! pool)) diff --git a/backend/src/app/util/cache.clj b/backend/src/app/util/cache.clj index c5aa733e6f..65861e1797 100644 --- a/backend/src/app/util/cache.clj +++ b/backend/src/app/util/cache.clj @@ -9,61 +9,71 @@ (:refer-clojure :exclude [get]) (:require [app.util.time :as dt] - [promesa.core :as p] [promesa.exec :as px]) (:import com.github.benmanes.caffeine.cache.AsyncCache - com.github.benmanes.caffeine.cache.AsyncLoadingCache - com.github.benmanes.caffeine.cache.CacheLoader + com.github.benmanes.caffeine.cache.Cache com.github.benmanes.caffeine.cache.Caffeine com.github.benmanes.caffeine.cache.RemovalListener + com.github.benmanes.caffeine.cache.stats.CacheStats java.time.Duration java.util.concurrent.Executor java.util.function.Function)) (set! *warn-on-reflection* true) -(defn create-listener +(defprotocol ICache + (get [_ k] [_ k load-fn] "get cache entry") + (invalidate! [_] [_ k] "invalidate cache")) + +(defprotocol ICacheStats + (stats [_] "get stats")) + +(defn- create-listener [f] (reify RemovalListener (onRemoval [_ key val cause] (when val (f key val cause))))) -(defn create-loader - [f] - (reify CacheLoader - (load [_ key] - (f key)))) +(defn- get-stats + [^Cache cache] + (let [^CacheStats stats (.stats cache)] + {:hit-rate (.hitRate stats) + :hit-count (.hitCount stats) + :req-count (.requestCount stats) + :miss-count (.missCount stats) + :miss-rate (.missRate stats)})) (defn create - [& {:keys [executor on-remove load-fn keepalive]}] - (as-> (Caffeine/newBuilder) builder - (if on-remove (.removalListener builder (create-listener on-remove)) builder) - (if executor (.executor builder ^Executor (px/resolve-executor executor)) builder) - (if keepalive (.expireAfterAccess builder ^Duration (dt/duration keepalive)) builder) - (if load-fn - (.buildAsync builder ^CacheLoader (create-loader load-fn)) - (.buildAsync builder)))) + [& {:keys [executor on-remove max-size keepalive]}] + (let [cache (as-> (Caffeine/newBuilder) builder + (if (fn? on-remove) (.removalListener builder (create-listener on-remove)) builder) + (if executor (.executor builder ^Executor (px/resolve-executor executor)) builder) + (if keepalive (.expireAfterAccess builder ^Duration (dt/duration keepalive)) builder) + (if (int? max-size) (.maximumSize builder (long max-size)) builder) + (.recordStats builder) + (.buildAsync builder)) + cache (.synchronous ^AsyncCache cache)] + (reify + ICache + (get [_ k] + (.getIfPresent ^Cache cache ^Object k)) + (get [_ k load-fn] + (.get ^Cache cache + ^Object k + ^Function (reify Function + (apply [_ k] + (load-fn k))))) + (invalidate! [_] + (.invalidateAll ^Cache cache)) + (invalidate! [_ k] + (.invalidateAll ^Cache cache ^Object k)) -(defn invalidate-all! - [^AsyncCache cache] - (.invalidateAll (.synchronous cache))) - -(defn get - ([cache key] - (assert (instance? AsyncLoadingCache cache) "should be AsyncLoadingCache instance") - (p/await! (.get ^AsyncLoadingCache cache ^Object key))) - ([cache key not-found-fn] - (assert (instance? AsyncCache cache) "should be AsyncCache instance") - (p/await! (.get ^AsyncCache cache - ^Object key - ^Function (reify - Function - (apply [_ key] - (not-found-fn key))))))) + ICacheStats + (stats [_] + (get-stats cache))))) (defn cache? [o] - (or (instance? AsyncCache o) - (instance? AsyncLoadingCache o))) + (satisfies? ICache o)) diff --git a/backend/src/app/util/pointer_map.clj b/backend/src/app/util/pointer_map.clj index 6e8e76b828..bb7b252939 100644 --- a/backend/src/app/util/pointer_map.clj +++ b/backend/src/app/util/pointer_map.clj @@ -166,32 +166,36 @@ (assoc [this key val] (when-not loaded? (load! this)) - (let [odata (assoc odata key val) - mdata (assoc mdata :created-at (dt/now)) - id (if modified? id (uuid/next)) - pmap (PointerMap. id - mdata - odata - true - true)] - (some-> *tracked* (swap! assoc id pmap)) - pmap)) + (let [odata' (assoc odata key val)] + (if (identical? odata odata') + this + (let [mdata (assoc mdata :created-at (dt/now)) + id (if modified? id (uuid/next)) + pmap (PointerMap. id + mdata + odata' + true + true)] + (some-> *tracked* (swap! assoc id pmap)) + pmap)))) (assocEx [_ _ _] (throw (UnsupportedOperationException. "method not implemented"))) (without [this key] (when-not loaded? (load! this)) - (let [odata (dissoc odata key) - mdata (assoc mdata :created-at (dt/now)) - id (if modified? id (uuid/next)) - pmap (PointerMap. id - mdata - odata - true - true)] - (some-> *tracked* (swap! assoc id pmap)) - pmap)) + (let [odata' (dissoc odata key)] + (if (identical? odata odata') + this + (let [mdata (assoc mdata :created-at (dt/now)) + id (if modified? id (uuid/next)) + pmap (PointerMap. id + mdata + odata' + true + true)] + (some-> *tracked* (swap! assoc id pmap)) + pmap)))) Counted (count [this] @@ -206,6 +210,8 @@ (defn create ([] (let [id (uuid/next) + + mdata (assoc *metadata* :created-at (dt/now)) pmap (PointerMap. id mdata {} true true)] (some-> *tracked* (swap! assoc id pmap)) @@ -225,7 +231,15 @@ (do (some-> *tracked* (swap! assoc (get-id data) data)) data) - (into (create) data))) + (let [mdata (assoc (meta data) :created-at (dt/now)) + id (uuid/next) + pmap (PointerMap. id + mdata + data + true + true)] + (some-> *tracked* (swap! assoc id pmap)) + pmap))) (fres/add-handlers! {:name "penpot/pointer-map/v1" diff --git a/backend/src/app/util/time.clj b/backend/src/app/util/time.clj index d3611d71e6..7785966245 100644 --- a/backend/src/app/util/time.clj +++ b/backend/src/app/util/time.clj @@ -123,7 +123,6 @@ FileTime (inst-ms* [v] (.toMillis ^FileTime v))) - (defmethod print-method Duration [mv ^java.io.Writer writer] (.write writer (str "#app/duration \"" (str/lower (subs (str mv) 2)) "\""))) diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index 6be373a29c..510aadd892 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -166,18 +166,21 @@ :name "test" :id page-id}]) - ;; Check the number of fragments - (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] - (t/is (= 2 (count rows)))) - - ;; Check the number of fragments - (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] - (t/is (= 2 (count rows)))) - - ;; The file-gc should remove unused fragments + ;; The file-gc should mark for remove unused fragments (let [res (th/run-task! :file-gc {:min-age 0})] (t/is (= 1 (:processed res)))) + ;; Check the number of fragments + (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] + (t/is (= 2 (count rows)))) + + ;; The objects-gc should remove unused fragments + (let [res (th/run-task! :objects-gc {:min-age 0})] + (t/is (= 0 (:processed res)))) + + ;; Check the number of fragments + (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] + (t/is (= 2 (count rows)))) ;; Add shape to page that should add a new fragment (update-file! @@ -202,10 +205,14 @@ (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (t/is (= 3 (count rows)))) - ;; The file-gc should remove unused fragments + ;; The file-gc should mark for remove unused fragments (let [res (th/run-task! :file-gc {:min-age 0})] (t/is (= 1 (:processed res)))) + ;; The objects-gc should remove unused fragments + (let [res (th/run-task! :objects-gc {:min-age 0})] + (t/is (= 0 (:processed res)))) + ;; Check the number of fragments; should be 3 because changes ;; are also holding pointers to fragments; (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] @@ -235,8 +242,6 @@ (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (t/is (= 2 (count rows))))))) - - (t/deftest file-gc-task-with-thumbnails (letfn [(add-file-media-object [& {:keys [profile-id file-id]}] (let [mfile {:filename "sample.jpg" diff --git a/common/deps.edn b/common/deps.edn index f8c649fab6..61c52e9099 100644 --- a/common/deps.edn +++ b/common/deps.edn @@ -32,7 +32,7 @@ funcool/tubax {:mvn/version "2021.05.20-0"} funcool/cuerdas {:mvn/version "2023.11.09-407"} - funcool/promesa {:git/sha "484b7f5c0d08d817746caa685ed9ac5583eb37fa" + funcool/promesa {:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0" :git/url "https://github.com/funcool/promesa"} funcool/datoteka {:mvn/version "3.0.66" diff --git a/common/src/app/common/data.cljc b/common/src/app/common/data.cljc index d814b14392..12e3f7762b 100644 --- a/common/src/app/common/data.cljc +++ b/common/src/app/common/data.cljc @@ -7,7 +7,7 @@ (ns app.common.data "A collection if helpers for working with data structures and other data resources." - (:refer-clojure :exclude [read-string hash-map merge name update-vals + (:refer-clojure :exclude [read-string hash-map merge name parse-double group-by iteration concat mapcat parse-uuid max min]) #?(:cljs @@ -216,12 +216,19 @@ [coll] (into [] (remove nil?) coll)) + (defn without-nils "Given a map, return a map removing key-value pairs when value is `nil`." - ([] (remove (comp nil? val))) + ([] + (remove (comp nil? val))) ([data] - (into {} (without-nils) data))) + (reduce-kv (fn [data k v] + (if (nil? v) + (dissoc data k) + data)) + data + data))) (defn without-qualified ([] diff --git a/common/src/app/common/exceptions.cljc b/common/src/app/common/exceptions.cljc index b01914ca56..2070986fe3 100644 --- a/common/src/app/common/exceptions.cljc +++ b/common/src/app/common/exceptions.cljc @@ -7,10 +7,12 @@ (ns app.common.exceptions "A helpers for work with exceptions." #?(:cljs (:require-macros [app.common.exceptions])) + (:refer-clojure :exclude [instance?]) (:require #?(:clj [clojure.stacktrace :as strace]) [app.common.pprint :as pp] [app.common.schema :as sm] + [clojure.core :as c] [clojure.spec.alpha :as s] [cuerdas.core :as str] [expound.alpha :as expound]) @@ -20,6 +22,9 @@ #?(:clj (set! *warn-on-reflection* true)) +(def ^:dynamic *data-length* 8) +(def ^:dynamic *data-level* 8) + (defmacro error [& {:keys [type hint] :as params}] `(ex-info ~(or hint (name type)) @@ -49,20 +54,38 @@ (defn ex-info? [v] - (instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v)) + (c/instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v)) (defn error? [v] - (instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v)) + (c/instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v)) (defn exception? [v] - (instance? #?(:clj java.lang.Throwable :cljs js/Error) v)) + (c/instance? #?(:clj java.lang.Throwable :cljs js/Error) v)) #?(:clj (defn runtime-exception? [v] - (instance? RuntimeException v))) + (c/instance? RuntimeException v))) + +#?(:clj + (defn instance? + [class cause] + (loop [cause cause] + (if (c/instance? class cause) + true + (if-let [cause (ex-cause cause)] + (recur cause) + false))))) + +;; NOTE: idea for a macro for error handling +;; (pu/try-let [cause (p/await (get-object-data backend object))] +;; (ex/instance? NoSuchKeyException cause) +;; (ex/raise :type :not-found +;; :code :object-not-found +;; :hint "s3 object not found" +;; :cause cause)) (defn explain [data & {:as opts}] @@ -91,8 +114,8 @@ data? true explain? true chain? true - data-length 8 - data-level 5}}] + data-length *data-length* + data-level *data-level*}}] (letfn [(print-trace-element [^StackTraceElement e] (let [class (.getClassName e) diff --git a/common/src/app/common/files/defaults.cljc b/common/src/app/common/files/defaults.cljc index 12e18921eb..e35914d73f 100644 --- a/common/src/app/common/files/defaults.cljc +++ b/common/src/app/common/files/defaults.cljc @@ -6,4 +6,4 @@ (ns app.common.files.defaults) -(def version 38) +(def version 44) diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index c5952d5718..39d448597c 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -19,9 +19,11 @@ [app.common.geom.shapes.text :as gsht] [app.common.logging :as l] [app.common.math :as mth] + [app.common.schema :as sm] [app.common.svg :as csvg] [app.common.text :as txt] [app.common.types.shape :as cts] + [app.common.types.shape.shadow :as ctss] [app.common.uuid :as uuid] [cuerdas.core :as str])) @@ -31,6 +33,10 @@ (defmulti migrate :version) +(defn need-migration? + [{:keys [data]}] + (> cfd/version (:version data 0))) + (defn migrate-data ([data] (migrate-data data version)) ([data to-version] @@ -318,19 +324,21 @@ (= "#7B7D85" fill-color))) (dissoc :fill-color :fill-opacity)))) - (update-container [{:keys [objects] :as container}] - (loop [objects objects - shapes (->> (vals objects) - (filter cfh/image-shape?))] - (if-let [shape (first shapes)] - (let [{:keys [id frame-id] :as shape'} (process-shape shape)] - (if (identical? shape shape') - (recur objects (rest shapes)) - (recur (-> objects - (assoc id shape') - (d/update-when frame-id dissoc :thumbnail)) - (rest shapes)))) - (assoc container :objects objects))))] + (update-container [container] + (if (contains? container :objects) + (loop [objects (:objects container) + shapes (->> (vals objects) + (filter cfh/image-shape?))] + (if-let [shape (first shapes)] + (let [{:keys [id frame-id] :as shape'} (process-shape shape)] + (if (identical? shape shape') + (recur objects (rest shapes)) + (recur (-> objects + (assoc id shape') + (d/update-when frame-id dissoc :thumbnail)) + (rest shapes)))) + (assoc container :objects objects))) + container))] (-> data (update :pages-index update-vals update-container) @@ -380,7 +388,7 @@ (assign-fills))) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) @@ -409,7 +417,7 @@ (assoc :fills []))) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) @@ -424,7 +432,7 @@ (dissoc :position-data))) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) @@ -440,7 +448,7 @@ (dissoc :position-data))) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) @@ -527,7 +535,7 @@ (assoc object :frame-id calculated-frame-id))) (update-container [container] - (update container :objects #(update-vals % (partial update-object %))))] + (d/update-when container :objects #(update-vals % (partial update-object %))))] (-> data (update :pages-index update-vals update-container) @@ -565,22 +573,7 @@ (update :content #(txt/transform-nodes invalid-node? fix-node %))))) (update-container [container] - (update container :objects update-vals update-object))] - - (-> data - (update :pages-index update-vals update-container) - (update :components update-vals update-container)))) - -(defmethod migrate 30 - [data] - (letfn [(update-object [object] - (if (and (cfh/frame-shape? object) - (not (:shapes object))) - (assoc object :shapes []) - object)) - - (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) @@ -613,7 +606,8 @@ object))) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] + (-> data (update :pages-index update-vals update-container) (update :components update-vals update-container)))) @@ -624,13 +618,13 @@ ;; Ensure all root objects are well formed shapes. (if (= (:id object) uuid/zero) (-> object - (assoc :parent-id uuid/zero - :frame-id uuid/zero) + (assoc :parent-id uuid/zero) + (assoc :frame-id uuid/zero) (cts/setup-shape)) object)) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container)))) @@ -642,7 +636,7 @@ (dissoc object :x :y :width :height) object)) (update-container [container] - (update container :objects update-vals update-object))] + (d/update-when container :objects update-vals update-object))] (-> data (update :pages-index update-vals update-container) (update :components update-vals update-container)))) @@ -694,8 +688,144 @@ shape))) (update-container [container] - (update container :objects update-vals update-shape))] + (d/update-when container :objects update-vals update-shape))] (-> data (update :pages-index update-vals update-container) (update :components update-vals update-container)))) + +(defmethod migrate 39 + [data] + (letfn [(update-shape [shape] + (if (and (cfh/bool-shape? shape) + (not (contains? shape :bool-content))) + (assoc shape :bool-content []) + shape)) + + (update-container [container] + (d/update-when container :objects update-vals update-shape))] + + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) + +(defmethod migrate 40 + [data] + (letfn [(update-shape [{:keys [content shapes] :as shape}] + ;; Fix frame shape that in reallity is a path shape + (if (and (cfh/frame-shape? shape) + (contains? shape :selrect) + (seq content) + (not (seq shapes)) + (contains? (first content) :command)) + (-> shape + (assoc :type :path) + (assoc :x nil) + (assoc :y nil) + (assoc :width nil) + (assoc :height nil)) + shape)) + + (update-container [container] + (d/update-when container :objects update-vals update-shape))] + + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) + +(defmethod migrate 41 + [data] + (letfn [(update-shape [shape] + (cond + (or (cfh/bool-shape? shape) + (cfh/path-shape? shape)) + shape + + ;; Fix all shapes that has geometry broken but still + ;; preservers the selrect, so we recalculate the + ;; geometry from selrect. + (and (contains? shape :selrect) + (or (nil? (:x shape)) + (nil? (:y shape)) + (nil? (:width shape)) + (nil? (:height shape)))) + (let [selrect (:selrect shape)] + (-> shape + (assoc :x (:x selrect)) + (assoc :y (:y selrect)) + (assoc :width (:width selrect)) + (assoc :height (:height selrect)))) + + :else + shape)) + + (update-container [container] + (d/update-when container :objects update-vals update-shape))] + + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) + +(defmethod migrate 42 + [data] + (letfn [(update-object [object] + (if (and (or (cfh/frame-shape? object) + (cfh/group-shape? object) + (cfh/bool-shape? object)) + (not (:shapes object))) + (assoc object :shapes []) + object)) + + (update-container [container] + (d/update-when container :objects update-vals update-object))] + + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) + +(def ^:private valid-fill? + (sm/lazy-validator ::cts/fill)) + +(defmethod migrate 43 + [data] + (letfn [(update-text-node [node] + (-> node + (d/update-when :fills #(filterv valid-fill? %)) + (d/without-nils))) + + (update-object [object] + (if (cfh/text-shape? object) + (update object :content #(txt/transform-nodes identity update-text-node %)) + object)) + + (update-container [container] + (d/update-when container :objects update-vals update-object))] + + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) + +(def ^:private valid-shadow? + (sm/lazy-validator ::ctss/shadow)) + +(defmethod migrate 44 + [data] + (letfn [(fix-shadow [shadow] + (if (string? (:color shadow)) + (let [color {:color (:color shadow) + :opacity 1}] + (assoc shadow :color color)) + shadow)) + + (update-object [object] + (d/update-when object :shadow + #(into [] + (comp (map fix-shadow) + (filter valid-shadow?)) + %))) + + (update-container [container] + (d/update-when container :objects update-vals update-object))] + (-> data + (update :pages-index update-vals update-container) + (update :components update-vals update-container)))) diff --git a/common/src/app/common/files/repair.cljc b/common/src/app/common/files/repair.cljc index 8aead05bc2..4a824682e9 100644 --- a/common/src/app/common/files/repair.cljc +++ b/common/src/app/common/files/repair.cljc @@ -66,6 +66,19 @@ (pcb/with-file-data file-data) (pcb/update-shapes [(:parent-id shape)] repair-shape)))) +(defmethod repair-error :duplicated-children + [_ {:keys [shape page-id] :as error} file-data _] + (let [repair-shape + (fn [shape] + ; Remove duplicated + (log/debug :hint " -> remove duplicated children") + (update shape :shapes distinct))] + + (log/dbg :hint "repairing shape :duplicated-children" :id (:id shape) :name (:name shape) :page-id page-id) + (-> (pcb/empty-changes nil page-id) + (pcb/with-file-data file-data) + (pcb/update-shapes [(:id shape)] repair-shape)))) + (defmethod repair-error :child-not-found [_ {:keys [shape page-id args] :as error} file-data _] (let [repair-shape diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index 514e48ab16..01373f93c8 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -26,6 +26,7 @@ #{:invalid-geometry :parent-not-found :child-not-in-parent + :duplicated-children :child-not-found :frame-not-found :invalid-frame @@ -105,7 +106,7 @@ (nil? (:selrect shape)) (nil? (:points shape)))) (report-error :invalid-geometry - "Shape greometry is invalid" + "Shape geometry is invalid" shape file page))) (defn- check-parent-children @@ -123,6 +124,11 @@ (str/ffmt "Shape % not in parent's children list" (:id shape)) shape file page))) + (when-not (= (count (:shapes shape)) (count (distinct (:shapes shape)))) + (report-error :duplicated-children + (str/ffmt "Shape % has duplicated children" (:id shape)) + shape file page)) + (doseq [child-id (:shapes shape)] (let [child (ctst/get-shape page child-id)] (if (nil? child) @@ -367,64 +373,63 @@ [shape-id file page libraries & {:keys [context] :or {context :not-component}}] (let [shape (ctst/get-shape page shape-id)] (when (some? shape) - (do - (check-geometry shape file page) - (check-parent-children shape file page) - (check-frame shape file page) + (check-geometry shape file page) + (check-parent-children shape file page) + (check-frame shape file page) - (if (ctk/instance-head? shape) - (if (not= :frame (:type shape)) - (report-error :instance-head-not-frame - "Instance head should be a frame" + (if (ctk/instance-head? shape) + (if (not= :frame (:type shape)) + (report-error :instance-head-not-frame + "Instance head should be a frame" + shape file page) + + (if (ctk/instance-root? shape) + (if (ctk/main-instance? shape) + (if (not= context :not-component) + (report-error :root-main-not-allowed + "Root main component not allowed inside other component" + shape file page) + (check-shape-main-root-top shape file page libraries)) + + (if (not= context :not-component) + (report-error :root-copy-not-allowed + "Root copy component not allowed inside other component" + shape file page) + (check-shape-copy-root-top shape file page libraries))) + + (if (ctk/main-instance? shape) + ;; mains can't be nested into mains + (if (or (= context :not-component) (= context :main-top)) + (report-error :nested-main-not-allowed + "Nested main component only allowed inside other component" + shape file page) + (check-shape-main-root-nested shape file page libraries)) + + (if (= context :not-component) + (report-error :nested-copy-not-allowed + "Nested copy component only allowed inside other component" + shape file page) + (check-shape-copy-root-nested shape file page libraries))))) + + (if (ctk/in-component-copy? shape) + (if-not (#{:copy-top :copy-nested :copy-any} context) + (report-error :not-head-copy-not-allowed + "Non-root copy only allowed inside a copy" shape file page) + (check-shape-copy-not-root shape file page libraries)) - (if (ctk/instance-root? shape) - (if (ctk/main-instance? shape) - (if (not= context :not-component) - (report-error :root-main-not-allowed - "Root main component not allowed inside other component" - shape file page) - (check-shape-main-root-top shape file page libraries)) - - (if (not= context :not-component) - (report-error :root-copy-not-allowed - "Root copy component not allowed inside other component" - shape file page) - (check-shape-copy-root-top shape file page libraries))) - - (if (ctk/main-instance? shape) - ;; mains can't be nested into mains - (if (or (= context :not-component) (= context :main-top)) - (report-error :nested-main-not-allowed - "Nested main component only allowed inside other component" - shape file page) - (check-shape-main-root-nested shape file page libraries)) - - (if (= context :not-component) - (report-error :nested-copy-not-allowed - "Nested copy component only allowed inside other component" - shape file page) - (check-shape-copy-root-nested shape file page libraries))))) - - (if (ctk/in-component-copy? shape) - (if-not (#{:copy-top :copy-nested :copy-any} context) - (report-error :not-head-copy-not-allowed - "Non-root copy only allowed inside a copy" + (if (ctn/inside-component-main? (:objects page) shape) + (if-not (#{:main-top :main-nested :main-any} context) + (report-error :not-head-main-not-allowed + "Non-root main only allowed inside a main component" shape file page) - (check-shape-copy-not-root shape file page libraries)) + (check-shape-main-not-root shape file page libraries)) - (if (ctn/inside-component-main? (:objects page) shape) - (if-not (#{:main-top :main-nested :main-any} context) - (report-error :not-head-main-not-allowed - "Non-root main only allowed inside a main component" - shape file page) - (check-shape-main-not-root shape file page libraries)) - - (if (#{:main-top :main-nested :main-any} context) - (report-error :not-component-not-allowed - "Not compoments are not allowed inside a main" - shape file page) - (check-shape-not-component shape file page libraries))))))))) + (if (#{:main-top :main-nested :main-any} context) + (report-error :not-component-not-allowed + "Not compoments are not allowed inside a main" + shape file page) + (check-shape-not-component shape file page libraries)))))))) (defn- check-component "Validate semantic coherence of a component. Report all errors found." @@ -484,6 +489,9 @@ (sm/lazy-explainer ::ctf/data)) (defn validate-file-schema! + "Validates the file itself, without external dependencies, it + performs the schema checking and some semantical validation of the + content." [{:keys [id data] :as file}] (when-not (valid-fdata? data) (ex/raise :type :validation diff --git a/common/src/app/common/geom/shapes/path.cljc b/common/src/app/common/geom/shapes/path.cljc index 018beaeb39..84f0b52418 100644 --- a/common/src/app/common/geom/shapes/path.cljc +++ b/common/src/app/common/geom/shapes/path.cljc @@ -981,6 +981,7 @@ selrect (-> points (gco/transform-points points-center transform-inverse) (grc/points->rect))] + [points selrect])) (defn open-path? diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index 7fed63b77b..b1e743f643 100644 --- a/common/src/app/common/schema.cljc +++ b/common/src/app/common/schema.cljc @@ -14,6 +14,7 @@ [app.common.schema.generators :as sg] [app.common.schema.openapi :as-alias oapi] [app.common.schema.registry :as sr] + [app.common.time :as tm] [app.common.uri :as u] [app.common.uuid :as uuid] [clojure.core :as c] @@ -625,7 +626,8 @@ {:title "inst" :description "Satisfies Inst protocol" :error/message "expected to be number in safe range" - :gen/gen (sg/small-int) + :gen/gen (->> (sg/small-int) + (sg/fmap (fn [v] (tm/instant v)))) ::oapi/type "number" ::oapi/format "int64"}}) @@ -658,6 +660,9 @@ ;; ---- PREDICATES +(def valid-safe-number? + (lazy-validator ::safe-number)) + (def check-safe-int! (check-fn ::safe-int)) diff --git a/common/src/app/common/schema/generators.cljc b/common/src/app/common/schema/generators.cljc index f1aa8c90fd..83e00bfd87 100644 --- a/common/src/app/common/schema/generators.cljc +++ b/common/src/app/common/schema/generators.cljc @@ -5,7 +5,7 @@ ;; Copyright (c) KALEIDOS INC (ns app.common.schema.generators - (:refer-clojure :exclude [set subseq uuid for filter map]) + (:refer-clojure :exclude [set subseq uuid for filter map let]) #?(:cljs (:require-macros [app.common.schema.generators])) (:require [app.common.schema.registry :as sr] @@ -37,6 +37,10 @@ [& params] `(tp/for-all ~@params)) +(defmacro let + [& params] + `(tg/let ~@params)) + (defn check! [p & {:keys [num] :or {num 20} :as options}] (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50))) @@ -124,6 +128,10 @@ [f g] (tg/fmap f g)) +(defn mcat + [f g] + (tg/bind g f)) + (defn tuple [& opts] (apply tg/tuple opts)) diff --git a/common/src/app/common/svg.cljc b/common/src/app/common/svg.cljc index 6bca95abab..e0c718362b 100644 --- a/common/src/app/common/svg.cljc +++ b/common/src/app/common/svg.cljc @@ -31,7 +31,7 @@ (def xml-id-regex #"#([:A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF][\.\-\:0-9\xB7A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0300-\u036F\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u203F-\u2040\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF]*)") (def matrices-regex #"(matrix|translate|scale|rotate|skewX|skewY)\(([^\)]*)\)") -(def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?") +(def number-regex #"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?") (def tags-to-remove #{:linearGradient :radialGradient :metadata :mask :clipPath :filter :title}) @@ -759,40 +759,39 @@ ;; Transforms spec: ;; https://www.w3.org/TR/SVG11/single-page.html#coords-TransformAttribute -(defn format-translate-params +(defn- format-translate-params [params] (assert (or (= (count params) 1) (= (count params) 2))) (if (= (count params) 1) [(gpt/point (nth params 0) 0)] [(gpt/point (nth params 0) (nth params 1))])) -(defn format-scale-params +(defn- format-scale-params [params] (assert (or (= (count params) 1) (= (count params) 2))) (if (= (count params) 1) [(gpt/point (nth params 0))] [(gpt/point (nth params 0) (nth params 1))])) -(defn format-rotate-params +(defn- format-rotate-params [params] (assert (or (= (count params) 1) (= (count params) 3)) (str "??" (count params))) (if (= (count params) 1) [(nth params 0) (gpt/point 0 0)] [(nth params 0) (gpt/point (nth params 1) (nth params 2))])) -(defn format-skew-x-params +(defn- format-skew-x-params [params] (assert (= (count params) 1)) [(nth params 0) 0]) -(defn format-skew-y-params +(defn- format-skew-y-params [params] (assert (= (count params) 1)) [0 (nth params 0)]) -(defn to-matrix - [{:keys [type params]}] - (assert (#{"matrix" "translate" "scale" "rotate" "skewX" "skewY"} type)) +(defn- to-matrix + [type params] (case type "matrix" (apply gmt/matrix params) "translate" (apply gmt/translate-matrix (format-translate-params params)) @@ -802,19 +801,17 @@ "skewY" (apply gmt/skew-matrix (format-skew-y-params params)))) (defn parse-transform - [transform-attr] - (if transform-attr - (let [process-matrix - (fn [[_ type params]] - (let [params (->> (re-seq number-regex params) - (filter #(-> % first seq)) - (map (comp d/parse-double first)))] - {:type type :params params})) + [transform] + (if (string? transform) + (->> (re-seq matrices-regex transform) + (map (fn [[_ type params]] + (let [params (->> (re-seq number-regex params) + (map first) + (keep not-empty) + (map d/parse-double))] + (to-matrix type params)))) + (reduce gmt/multiply (gmt/matrix))) - matrices (->> (re-seq matrices-regex transform-attr) - (map process-matrix) - (map to-matrix))] - (reduce gmt/multiply (gmt/matrix) matrices)) (gmt/matrix))) (defn format-move [[x y]] (str "M" x " " y)) @@ -872,17 +869,21 @@ transform (update :transform append-transform)))) -(defn inherit-attributes [group-attrs {:keys [attrs] :as node}] +(defn inherit-attributes + [group-attrs {:keys [attrs] :as node}] (if (map? node) - (let [attrs (-> (format-styles attrs) - (add-transform (:transform group-attrs))) + (let [attrs (-> (format-styles attrs) + (add-transform (:transform group-attrs))) + group-attrs (format-styles group-attrs) ;; Don't inherit a property that is already in the style attribute inherit-style (-> (:style group-attrs) (d/without-keys (keys attrs))) inheritable-props (->> inheritable-props (remove #(contains? (:styles attrs) %))) group-attrs (-> group-attrs (assoc :style inherit-style)) - attrs (d/deep-merge (select-keys group-attrs inheritable-props) attrs)] + attrs (-> (select-keys group-attrs inheritable-props) + (d/deep-merge attrs) + (d/without-nils))] (assoc node :attrs attrs)) node)) @@ -964,8 +965,7 @@ is-other? #{:r :stroke-width}] (if is-percent? - ;; JS parseFloat removes the % symbol - (let [attr-num (d/parse-double attr-val)] + (let [attr-num (d/parse-double (str/rtrim attr-val "%"))] (str (cond (is-x? attr-key) (fix-coord :x :width attr-num) (is-y? attr-key) (fix-coord :y :height attr-num) @@ -981,7 +981,7 @@ (fix-percent-attr-numeric [_ attr-val] (let [is-percent? (str/ends-with? attr-val "%")] (if is-percent? - (str (let [attr-num (d/parse-double attr-val)] + (str (let [attr-num (d/parse-double (str/rtrim attr-val "%"))] (/ attr-num 100))) attr-val))) diff --git a/common/src/app/common/svg/shapes_builder.cljc b/common/src/app/common/svg/shapes_builder.cljc index fc4b370ae7..343507f770 100644 --- a/common/src/app/common/svg/shapes_builder.cljc +++ b/common/src/app/common/svg/shapes_builder.cljc @@ -57,13 +57,15 @@ clean-value)) (defn- svg-dimensions - [data] - (let [width (dm/get-in data [:attrs :width] 100) - height (dm/get-in data [:attrs :height] 100) - viewbox (or (dm/get-in data [:attrs :viewBox]) + [{:keys [attrs] :as data}] + (let [width (:width attrs 100) + height (:height attrs 100) + viewbox (or (:viewBox attrs) (dm/str "0 0 " width " " height)) - [x y width height] (->> (str/split viewbox #"\s+") + + [x y width height] (->> (str/split viewbox #"[\s,]+") (map d/parse-double)) + width (if (= width 0) 1 width) height (if (= height 0) 1 height)] @@ -303,6 +305,11 @@ rx (d/nilv r rx) ry (d/nilv r ry) + + ;; There are some svg circles in the internet that does not + ;; have cx and cy attrs, so we default them to 0 + cx (d/nilv cx 0) + cy (d/nilv cy 0) origin (gpt/negate (gpt/point svg-data)) rect (grc/make-rect @@ -502,8 +509,16 @@ att-refs (csvg/find-attr-references attrs) defs (get svg-data :defs) references (csvg/find-def-references defs att-refs) - href-id (-> (or (:href attrs) (:xlink:href attrs) " ") (subs 1)) - use-tag? (and (= :use tag) (contains? defs href-id))] + + href-id (or (:href attrs) (:xlink:href attrs) " ") + href-id (if (and (string? href-id) + (pos? (count href-id))) + (subs href-id 1) + href-id) + + use-tag? (and (= :use tag) + (some? href-id) + (contains? defs href-id))] (if use-tag? (let [;; Merge the data of the use definition with the properties passed as attributes @@ -532,21 +547,20 @@ :image (create-image-shape name frame-id svg-data element) #_other (create-raw-svg name frame-id svg-data element))] - (when (some? shape) - (let [shape (-> shape - (assoc :svg-defs (select-keys defs references)) - (setup-fill) - (setup-stroke) - (setup-opacity) - (setup-other) - (update :svg-attrs (fn [attrs] - (if (empty? (:style attrs)) - (dissoc attrs :style) - attrs))))] - [(cond-> shape - hidden (assoc :hidden true)) + [(-> shape + (assoc :svg-defs (select-keys defs references)) + (setup-fill) + (setup-stroke) + (setup-opacity) + (setup-other) + (update :svg-attrs (fn [attrs] + (if (empty? (:style attrs)) + (dissoc attrs :style) + attrs))) + (cond-> ^boolean hidden + (assoc :hidden true))) - (cond->> (:content element) - (contains? csvg/parent-tags tag) - (mapv #(csvg/inherit-attributes attrs %)))])))))) + (cond->> (:content element) + (contains? csvg/parent-tags tag) + (mapv (partial csvg/inherit-attributes attrs)))]))))) diff --git a/common/src/app/common/time.cljc b/common/src/app/common/time.cljc index c32c82411e..6cd8601d66 100644 --- a/common/src/app/common/time.cljc +++ b/common/src/app/common/time.cljc @@ -4,16 +4,16 @@ ;; ;; Copyright (c) KALEIDOS INC -;; Here we put the time functions that are common between frontend and backend. -;; In the future we may create an unified API for both. - (ns app.common.time + "A new cross-platform date and time API. It should be prefered over + a platform specific implementation found on `app.util.time`." #?(:cljs (:require ["luxon" :as lxn]) :clj (:import - java.time.Instant))) + java.time.Instant + java.time.Duration))) #?(:cljs (def DateTime lxn/DateTime)) @@ -24,4 +24,47 @@ (defn now [] #?(:clj (Instant/now) - :cljs (.local ^js DateTime))) \ No newline at end of file + :cljs (.local ^js DateTime))) + +(defn instant + [s] + #?(:clj (Instant/ofEpochMilli s) + :cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false}))) + +#?(:cljs + (extend-protocol IComparable + DateTime + (-compare [it other] + (if ^boolean (.equals it other) + 0 + (if (< (inst-ms it) (inst-ms other)) -1 1))) + + Duration + (-compare [it other] + (if ^boolean (.equals it other) + 0 + (if (< (inst-ms it) (inst-ms other)) -1 1))))) + + +#?(:cljs + (extend-type DateTime + cljs.core/IEquiv + (-equiv [o other] + (and (instance? DateTime other) + (== (.valueOf o) (.valueOf other)))))) + +#?(:cljs + (extend-protocol cljs.core/Inst + DateTime + (inst-ms* [inst] (.toMillis ^js inst)) + + Duration + (inst-ms* [inst] (.toMillis ^js inst))) + + :clj + (extend-protocol clojure.core/Inst + Duration + (inst-ms* [v] (.toMillis ^Duration v)) + + Instant + (inst-ms* [v] (.toEpochMilli ^Instant v)))) diff --git a/common/src/app/common/types/color.cljc b/common/src/app/common/types/color.cljc index 8049628941..3a726d77a5 100644 --- a/common/src/app/common/types/color.cljc +++ b/common/src/app/common/types/color.cljc @@ -70,18 +70,20 @@ [:offset ::sm/safe-number]]]]]) (sm/define! ::color - [:map {:title "Color"} - [:id {:optional true} ::sm/uuid] - [:name {:optional true} :string] - [:path {:optional true} [:maybe :string]] - [:value {:optional true} [:maybe :string]] - [:color {:optional true} [:maybe ::rgb-color]] - [:opacity {:optional true} [:maybe ::sm/safe-number]] - [:modified-at {:optional true} ::sm/inst] - [:ref-id {:optional true} ::sm/uuid] - [:ref-file {:optional true} ::sm/uuid] - [:gradient {:optional true} [:maybe ::gradient]] - [:image {:optional true} [:maybe ::image-color]]]) + [:and + [:map {:title "Color"} + [:id {:optional true} ::sm/uuid] + [:name {:optional true} :string] + [:path {:optional true} [:maybe :string]] + [:value {:optional true} [:maybe :string]] + [:color {:optional true} [:maybe ::rgb-color]] + [:opacity {:optional true} [:maybe ::sm/safe-number]] + [:modified-at {:optional true} ::sm/inst] + [:ref-id {:optional true} ::sm/uuid] + [:ref-file {:optional true} ::sm/uuid] + [:gradient {:optional true} [:maybe ::gradient]] + [:image {:optional true} [:maybe ::image-color]]] + [::sm/contains-any {:strict true} [:color :gradient :image]]]) (sm/define! ::recent-color [:and diff --git a/common/src/app/common/types/page.cljc b/common/src/app/common/types/page.cljc index ec24c52a27..6c1d427dff 100644 --- a/common/src/app/common/types/page.cljc +++ b/common/src/app/common/types/page.cljc @@ -7,7 +7,6 @@ (ns app.common.types.page (:require [app.common.data :as d] - [app.common.features :as cfeat] [app.common.schema :as sm] [app.common.types.color :as-alias ctc] [app.common.types.grid :as ctg] @@ -71,13 +70,9 @@ (defn make-empty-page [id name] - (let [wrap-objects-fn cfeat/*wrap-with-objects-map-fn* - wrap-pointer-fn cfeat/*wrap-with-pointer-map-fn*] - (-> empty-page-data - (assoc :id id) - (assoc :name name) - (update :objects wrap-objects-fn) - (wrap-pointer-fn)))) + (-> empty-page-data + (assoc :id id) + (assoc :name name))) ;; --- Helpers for flow diff --git a/common/src/app/common/types/shape.cljc b/common/src/app/common/types/shape.cljc index 28289219d4..cdc7ccb163 100644 --- a/common/src/app/common/types/shape.cljc +++ b/common/src/app/common/types/shape.cljc @@ -25,6 +25,7 @@ [app.common.types.shape.export :as ctse] [app.common.types.shape.interactions :as ctsi] [app.common.types.shape.layout :as ctsl] + [app.common.types.shape.path :as ctsp] [app.common.types.shape.shadow :as ctss] [app.common.types.shape.text :as ctsx] [app.common.uuid :as uuid] @@ -46,6 +47,7 @@ :bool :rect :path + :text :circle :svg-raw :image}) @@ -126,21 +128,24 @@ [:stroke-color-gradient {:optional true} ::ctc/gradient] [:stroke-image {:optional true} ::ctc/image-color]]) -(sm/define! ::minimal-shape-attrs +(sm/define! ::shape-base-attrs [:map {:title "ShapeMinimalRecord"} - [:id {:optional false} ::sm/uuid] - [:name {:optional false} :string] - [:type {:optional false} [::sm/one-of shape-types]] - [:x {:optional false} [:maybe ::sm/safe-number]] - [:y {:optional false} [:maybe ::sm/safe-number]] - [:width {:optional false} [:maybe ::sm/safe-number]] - [:height {:optional false} [:maybe ::sm/safe-number]] - [:selrect {:optional false} ::selrect] - [:points {:optional false} ::points] - [:transform {:optional false} ::gmt/matrix] - [:transform-inverse {:optional false} ::gmt/matrix] - [:parent-id {:optional false} ::sm/uuid] - [:frame-id {:optional false} ::sm/uuid]]) + [:id ::sm/uuid] + [:name :string] + [:type [::sm/one-of shape-types]] + [:selrect ::selrect] + [:points ::points] + [:transform ::gmt/matrix] + [:transform-inverse ::gmt/matrix] + [:parent-id ::sm/uuid] + [:frame-id ::sm/uuid]]) + +(sm/define! ::shape-geom-attrs + [:map {:title "ShapeGeometryAttrs"} + [:x ::sm/safe-number] + [:y ::sm/safe-number] + [:width ::sm/safe-number] + [:height ::sm/safe-number]]) (sm/define! ::shape-attrs [:map {:title "ShapeAttrs"} @@ -199,7 +204,7 @@ (sm/define! ::group-attrs [:map {:title "GroupAttrs"} [:type [:= :group]] - [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]]) + [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]) (sm/define! ::frame-attrs [:map {:title "FrameAttrs"} @@ -212,7 +217,7 @@ (sm/define! ::bool-attrs [:map {:title "BoolAttrs"} [:type [:= :bool]] - [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]] + [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]] ;; FIXME: improve this schema [:bool-type :keyword] @@ -252,16 +257,7 @@ (sm/define! ::path-attrs [:map {:title "PathAttrs"} [:type [:= :path]] - [:x {:optional true} [:maybe ::sm/safe-number]] - [:y {:optional true} [:maybe ::sm/safe-number]] - [:width {:optional true} [:maybe ::sm/safe-number]] - [:height {:optional true} [:maybe ::sm/safe-number]] - [:content - {:optional true} - [:vector - [:map - [:command :keyword] - [:params {:optional true} [:maybe :map]]]]]]) + [:content ::ctsp/content]]) (sm/define! ::text-attrs [:map {:title "TextAttrs"} @@ -271,72 +267,96 @@ (sm/define! ::shape-map [:multi {:dispatch :type :title "Shape"} [:group - [:merge {:title "GroupShape"} + [:and {:title "GroupShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::group-attrs ::ctsl/layout-child-attrs]] [:frame - [:merge {:title "FrameShape"} - ::minimal-shape-attrs + [:and {:title "FrameShape"} + ::shape-base-attrs + ::shape-geom-attrs ::frame-attrs ::ctsl/layout-attrs ::ctsl/layout-child-attrs]] [:bool - [:merge {:title "BoolShape"} + [:and {:title "BoolShape"} + ::shape-base-attrs ::shape-attrs - ::minimal-shape-attrs ::bool-attrs ::ctsl/layout-child-attrs]] [:rect - [:merge {:title "RectShape"} + [:and {:title "RectShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::rect-attrs ::ctsl/layout-child-attrs]] [:circle - [:merge {:title "CircleShape"} + [:and {:title "CircleShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::circle-attrs ::ctsl/layout-child-attrs]] [:image - [:merge {:title "ImageShape"} + [:and {:title "ImageShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::image-attrs ::ctsl/layout-child-attrs]] [:svg-raw - [:merge {:title "SvgRawShape"} + [:and {:title "SvgRawShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::svg-raw-attrs ::ctsl/layout-child-attrs]] [:path - [:merge {:title "PathShape"} + [:and {:title "PathShape"} + ::shape-base-attrs ::shape-attrs - ::minimal-shape-attrs ::path-attrs ::ctsl/layout-child-attrs]] [:text - [:merge {:title "TextShape"} + [:and {:title "TextShape"} + ::shape-base-attrs + ::shape-geom-attrs ::shape-attrs - ::minimal-shape-attrs ::text-attrs ::ctsl/layout-child-attrs]]]) (sm/define! ::shape [:and {:title "Shape" - :gen/gen (->> (sg/generator ::shape-map) + :gen/gen (->> (sg/generator ::shape-base-attrs) + (sg/mcat (fn [{:keys [type] :as shape}] + (sg/let [attrs1 (sg/generator ::shape-attrs) + attrs2 (sg/generator ::shape-geom-attrs) + attrs3 (case type + :text (sg/generator ::text-attrs) + :path (sg/generator ::path-attrs) + :svg-raw (sg/generator ::svg-raw-attrs) + :image (sg/generator ::image-attrs) + :circle (sg/generator ::circle-attrs) + :rect (sg/generator ::rect-attrs) + :bool (sg/generator ::bool-attrs) + :group (sg/generator ::group-attrs) + :frame (sg/generator ::frame-attrs))] + (if (or (= type :path) + (= type :bool)) + (merge attrs1 shape attrs3) + (merge attrs1 shape attrs2 attrs3))))) (sg/fmap map->Shape))} ::shape-map [:fn shape?]]) @@ -491,7 +511,12 @@ the shape. The props must have :x :y :width :height." [{:keys [type] :as props}] (let [shape (make-minimal-shape type) - shape (merge shape (d/without-nils props)) + + ;; The props can be custom records that does not + ;; work properly with without-nils, so we first make + ;; it plain map for proceed + props (d/without-nils (into {} props)) + shape (merge shape (d/without-nils (into {} props))) shape (case (:type shape) (:bool :path) (setup-path shape) :image (-> shape setup-rect setup-image) diff --git a/common/src/app/common/types/shape/path.cljc b/common/src/app/common/types/shape/path.cljc new file mode 100644 index 0000000000..d633bb85c6 --- /dev/null +++ b/common/src/app/common/types/shape/path.cljc @@ -0,0 +1,47 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns app.common.types.shape.path + (:require + [app.common.schema :as sm])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SCHEMA +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(sm/define! ::segment + [:multi {:title "PathSegment" :dispatch :command} + [:line-to + [:map + [:command [:= :line-to]] + [:params + [:map + [:x ::sm/safe-number] + [:y ::sm/safe-number]]]]] + [:close-path + [:map + [:command [:= :close-path]]]] + [:move-to + [:map + [:command [:= :move-to]] + [:params + [:map + [:x ::sm/safe-number] + [:y ::sm/safe-number]]]]] + [:curve-to + [:map + [:command [:= :curve-to]] + [:params + [:map + [:x ::sm/safe-number] + [:y ::sm/safe-number] + [:c1x ::sm/safe-number] + [:c1y ::sm/safe-number] + [:c2x ::sm/safe-number] + [:c2y ::sm/safe-number]]]]]]) + +(sm/define! ::content + [:vector ::segment]) diff --git a/common/src/app/common/types/shape/shadow.cljc b/common/src/app/common/types/shape/shadow.cljc index d04886fa3a..cc2fd81c3c 100644 --- a/common/src/app/common/types/shape/shadow.cljc +++ b/common/src/app/common/types/shape/shadow.cljc @@ -7,8 +7,7 @@ (ns app.common.types.shape.shadow (:require [app.common.schema :as sm] - [app.common.types.color :as ctc] - [app.common.types.shape.shadow.color :as-alias shadow-color])) + [app.common.types.color :as ctc])) (def styles #{:drop-shadow :inner-shadow}) @@ -21,11 +20,4 @@ [:blur ::sm/safe-number] [:spread ::sm/safe-number] [:hidden :boolean] - ;;FIXME: reuse color? - [:color - [:map - [:color {:optional true} :string] - [:opacity {:optional true} ::sm/safe-number] - [:gradient {:optional true} [:maybe ::ctc/gradient]] - [:file-id {:optional true} [:maybe ::sm/uuid]] - [:id {:optional true} [:maybe ::sm/uuid]]]]]) + [:color ::ctc/color]]) diff --git a/common/src/app/common/uuid.cljc b/common/src/app/common/uuid.cljc index b205c64534..2086a0a5bd 100644 --- a/common/src/app/common/uuid.cljc +++ b/common/src/app/common/uuid.cljc @@ -75,3 +75,12 @@ with base62. It is only safe to use with uuid v4 and penpot custom v8" [id] (impl/short-v8 (dm/str id)))) + +#?(:clj + (defn hash-int + [id] + (let [a (.getMostSignificantBits ^UUID id) + b (.getLeastSignificantBits ^UUID id)] + (+ (clojure.lang.Murmur3/hashLong a) + (clojure.lang.Murmur3/hashLong b))))) +