3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-07-30 23:38:29 +02:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source
This commit is contained in:
Andrey Antukh 2024-01-17 09:51:47 +01:00
commit a5d056f254
28 changed files with 949 additions and 104 deletions
Download patch file Download diff file Expand all files Collapse all files

1
backend/deps.edn
View file

@ -32,6 +32,7 @@
cider/cider-nrepl {:mvn/version "0.44.0"}
org.postgresql/postgresql {:mvn/version "42.7.1"}
org.xerial/sqlite-jdbc {:mvn/version "3.44.1.0"}
com.zaxxer/HikariCP {:mvn/version "5.1.0"}

713
backend/src/app/binfile/v2.clj Normal file
View file

@ -0,0 +1,713 @@
;; 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.binfile.v2
"A sqlite3 based binary file exportation with support for exportation
of entire team (or multiple teams) at once."
(:refer-clojure :exclude [read])
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.defaults :as cfd]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as fval]
[app.common.logging :as l]
[app.common.transit :as t]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.features.fdata :as feat.fdata]
[app.http.sse :as sse]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.media :as media]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.set :as set]
[clojure.walk :as walk]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.util :as pu])
(:import
java.sql.DriverManager))
(set! *warn-on-reflection* true)
(def ^:dynamic *state* nil)
(def ^:dynamic *options* nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOW LEVEL API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- lookup-index
[id]
(when-let [val (get-in @*state* [:index id])]
(l/trc :fn "lookup-index" :id (some-> id str) :result (some-> val str) ::l/sync? true)
(or val id)))
(defn- index-object
[index obj & attrs]
(reduce (fn [index attr-fn]
(let [old-id (attr-fn obj)
new-id (uuid/next)]
(assoc index old-id new-id)))
index
attrs))
(defn- update-index
([index coll]
(update-index index coll identity))
([index coll attr]
(reduce #(index-object %1 %2 attr) index coll)))
(defn- create-database
([cfg]
(let [path (tmp/tempfile :prefix "penpot.binfile." :suffix ".sqlite")]
(create-database cfg path)))
([cfg path]
(let [db (DriverManager/getConnection (str "jdbc:sqlite:" path))]
(assoc cfg ::db db ::path path))))
(def ^:private
sql:create-kvdata-table
"CREATE TABLE kvdata (
tag text NOT NULL,
key text NOT NULL,
val text NOT NULL,
dat blob NULL
)")
(def ^:private
sql:create-kvdata-index
"CREATE INDEX kvdata__tag_key__idx
ON kvdata (tag, key)")
(defn- decode-row
[{:keys [data features] :as row}]
(cond-> row
features (assoc :features (db/decode-pgarray features #{}))
data (assoc :data (blob/decode data))))
(defn- setup-schema!
[{:keys [::db]}]
(db/exec-one! db [sql:create-kvdata-table])
(db/exec-one! db [sql:create-kvdata-index]))
(defn- write!
[{:keys [::db]} tag k v & [data]]
(db/insert! db :kvdata
{:tag (d/name tag)
:key (str k)
:val (t/encode-str v {:type :json-verbose})
:dat data}
{::db/return-keys false}))
(defn- read-blob
[{:keys [::db]} tag k]
(let [obj (db/get db :kvdata
{:tag (d/name tag)
:key (str k)}
{::sql/columns [:dat]})]
(:dat obj)))
(defn- read-seq
([{:keys [::db]} tag]
(->> (db/query db :kvdata
{:tag (d/name tag)}
{::sql/columns [::val]})
(map :val)
(map t/decode-str)))
([{:keys [::db]} tag k]
(->> (db/query db :kvdata
{:tag (d/name tag)
:key (str k)}
{::sql/columns [::val]})
(map :val)
(map t/decode-str))))
(defn- read-obj
[{:keys [::db]} tag k]
(let [obj (db/get db :kvdata
{:tag (d/name tag)
:key (str k)}
{::sql/columns [:val]})]
(-> obj :val t/decode-str)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; IMPORT/EXPORT IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private xf-map-id
(map :id))
(def ^:private xf-map-media-id
(comp
(mapcat (juxt :media-id
:thumbnail-id
:woff1-file-id
:woff2-file-id
:ttf-file-id
:otf-file-id))
(filter uuid?)))
;; NOTE: Will be used in future, commented for satisfy linter
;; (def ^:private sql:get-libraries
;; "WITH RECURSIVE libs AS (
;; SELECT fl.id
;; FROM file AS fl
;; JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
;; WHERE flr.file_id = ANY(?)
;; UNION
;; SELECT fl.id
;; FROM file AS fl
;; JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
;; JOIN libs AS l ON (flr.file_id = l.id)
;; )
;; SELECT DISTINCT l.id
;; FROM libs AS l")
;;
;; (defn- get-libraries
;; "Get all libraries ids related to provided file ids"
;; [{:keys [::db/conn]} ids]
;; (let [ids' (db/create-array conn "uuid" ids)]
;; (->> (db/exec! conn [sql:get-libraries ids])
;; (into #{} xf-map-id))))
;;
;; (def ^:private sql:get-project-files
;; "SELECT f.id FROM file AS f
;; WHERE f.project_id = ?")
;; (defn- get-project-files
;; "Get a set of file ids for the project"
;; [{:keys [::db/conn]} project-id]
;; (->> (db/exec! conn [sql:get-project-files project-id])
;; (into #{} xf-map-id)))
(def ^:private sql:get-team-files
"SELECT f.id FROM file AS f
JOIN project AS p ON (p.id = f.project_id)
WHERE p.team_id = ?")
(defn- get-team-files
"Get a set of file ids for the specified team-id"
[{:keys [::db/conn]} team-id]
(->> (db/exec! conn [sql:get-team-files team-id])
(into #{} xf-map-id)))
(def ^:private sql:get-team-projects
"SELECT p.id FROM project AS p
WHERE p.team_id = ?")
(defn- get-team-projects
"Get a set of project ids for the team"
[{:keys [::db/conn]} team-id]
(->> (db/exec! conn [sql:get-team-projects team-id])
(into #{} xf-map-id)))
(declare ^:private write-project!)
(declare ^:private write-file!)
(defn- write-team!
[{:keys [::db/conn] :as cfg} team-id]
(sse/tap {:type :export-progress
:section :write-team
:id team-id})
(let [team (db/get conn :team {:id team-id}
::db/remove-deleted false
::db/check-deleted false)
team (decode-row team)
fonts (db/query conn :team-font-variant
{:team-id team-id
:deleted-at nil}
{::sql/for-share true})]
(l/trc :hint "write" :obj "team"
:id (str team-id)
:fonts (count fonts))
(vswap! *state* update :teams conj team-id)
(vswap! *state* update :storage-objects into xf-map-media-id fonts)
(write! cfg :team team-id team)
(doseq [{:keys [id] :as font} fonts]
(vswap! *state* update :team-font-variants conj id)
(write! cfg :team-font-variant id font))))
(defn- write-project!
[{:keys [::db/conn] :as cfg} project-id]
(sse/tap {:type :export-progress
:section :write-project
:id project-id})
(let [project (db/get conn :project {:id project-id}
::db/remove-deleted false
::db/check-deleted false)]
(l/trc :hint "write" :obj "project" :id (str project-id))
(write! cfg :project (str project-id) project)
(vswap! *state* update :projects conj project-id)))
(defn- write-file!
[{:keys [::db/conn] :as cfg} file-id]
(sse/tap {:type :export-progress
:section :write-file
:id file-id})
(let [file (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(-> (db/get conn :file {:id file-id}
::sql/for-share true
::db/remove-deleted false
::db/check-deleted false)
(decode-row)
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))))
thumbs (db/query conn :file-tagged-object-thumbnail
{:file-id file-id
:deleted-at nil}
{::sql/for-share true})
media (db/query conn :file-media-object
{:file-id file-id
:deleted-at nil}
{::sql/for-share true})
rels (db/query conn :file-library-rel
{:file-id file-id})]
(vswap! *state* (fn [state]
(-> state
(update :files conj file-id)
(update :file-media-objects into (map :id) media)
(update :storage-objects into xf-map-media-id thumbs)
(update :storage-objects into xf-map-media-id media))))
(write! cfg :file file-id file)
(write! cfg :file-rels file-id rels)
(run! (partial write! cfg :file-media-object file-id) media)
(run! (partial write! cfg :file-object-thumbnail file-id) thumbs)
(when-let [thumb (db/get* conn :file-thumbnail
{:file-id file-id
:revn (:revn file)
:data nil}
{::sql/for-share true
::sql/columns [:media-id :file-id :revn]})]
(vswap! *state* update :storage-objects into xf-map-media-id [thumb])
(write! cfg :file-thumbnail file-id thumb))
(l/trc :hint "write" :obj "file"
:thumbnails (count thumbs)
:rels (count rels)
:media (count media))))
(defn- write-storage-object!
[{:keys [::sto/storage] :as cfg} id]
(let [sobj (sto/get-object storage id)
data (with-open [input (sto/get-object-data storage sobj)]
(io/read-as-bytes input))]
(l/trc :hint "write" :obj "storage-object" :id (str id) :size (:size sobj))
(write! cfg :storage-object id (meta sobj) data)))
(defn- read-storage-object!
[{:keys [::sto/storage ::timestamp] :as cfg} id]
(let [mdata (read-obj cfg :storage-object id)
data (read-blob cfg :storage-object id)
hash (sto/calculate-hash data)
content (-> (sto/content data)
(sto/wrap-with-hash hash))
params (-> mdata
(assoc ::sto/content content)
(assoc ::sto/deduplicate? true)
(assoc ::sto/touched-at timestamp))
sobject (sto/put-object! storage params)]
(vswap! *state* update :index assoc id (:id sobject))
(l/trc :hint "read" :obj "storage-object"
:id (str id)
:new-id (str (:id sobject))
:size (:size sobject))))
(defn read-team!
[{:keys [::db/conn ::timestamp] :as cfg} team-id]
(l/trc :hint "read" :obj "team" :id (str team-id))
(sse/tap {:type :import-progress
:section :read-team
:id team-id})
(let [team (read-obj cfg :team team-id)
team (-> team
(update :id lookup-index)
(update :photo-id lookup-index)
(assoc :created-at timestamp)
(assoc :modified-at timestamp))]
(db/insert! conn :team
(update team :features db/encode-pgarray conn "text")
::db/return-keys false)
(doseq [font (->> (read-seq cfg :team-font-variant)
(filter #(= team-id (:team-id %))))]
(let [font (-> font
(update :id lookup-index)
(update :team-id lookup-index)
(update :woff1-file-id lookup-index)
(update :woff2-file-id lookup-index)
(update :ttf-file-id lookup-index)
(update :otf-file-id lookup-index)
(assoc :created-at timestamp)
(assoc :modified-at timestamp))]
(db/insert! conn :team-font-variant font
::db/return-keys false)))
team))
(defn read-project!
[{:keys [::db/conn ::timestamp] :as cfg} project-id]
(l/trc :hint "read" :obj "project" :id (str project-id))
(sse/tap {:type :import-progress
:section :read-project
:id project-id})
(let [project (read-obj cfg :project project-id)
project (-> project
(update :id lookup-index)
(update :team-id lookup-index)
(assoc :created-at timestamp)
(assoc :modified-at timestamp))]
(db/insert! conn :project project
::db/return-keys false)))
(defn- relink-shapes
"A function responsible to analyze all file data and
replace the old :component-file reference with the new
ones, using the provided file-index."
[data]
(letfn [(process-map-form [form]
(cond-> form
;; Relink image shapes
(and (map? (:metadata form))
(= :image (:type form)))
(update-in [:metadata :id] lookup-index)
;; Relink paths with fill image
(map? (:fill-image form))
(update-in [:fill-image :id] lookup-index)
;; This covers old shapes and the new :fills.
(uuid? (:fill-color-ref-file form))
(update :fill-color-ref-file lookup-index)
;; This covers the old shapes and the new :strokes
(uuid? (:storage-color-ref-file form))
(update :stroke-color-ref-file lookup-index)
;; This covers all text shapes that have typography referenced
(uuid? (:typography-ref-file form))
(update :typography-ref-file lookup-index)
;; This covers the component instance links
(uuid? (:component-file form))
(update :component-file lookup-index)
;; This covers the shadows and grids (they have directly
;; the :file-id prop)
(uuid? (:file-id form))
(update :file-id lookup-index)))]
(walk/postwalk (fn [form]
(if (map? form)
(try
(process-map-form form)
(catch Throwable cause
(l/warn :hint "failed form" :form (pr-str form) ::l/sync? true)
(throw cause)))
form))
data)))
(defn- relink-media
"A function responsible of process the :media attr of file data and
remap the old ids with the new ones."
[media]
(reduce-kv (fn [res k v]
(let [id (lookup-index k)]
(if (uuid? id)
(-> res
(assoc id (assoc v :id id))
(dissoc k))
res)))
media
media))
(defn- relink-colors
"A function responsible of process the :colors attr of file data and
remap the old ids with the new ones."
[colors]
(reduce-kv (fn [res k v]
(if (:image v)
(update-in res [k :image :id] lookup-index)
res))
colors
colors))
(defn- process-file
[{:keys [id] :as file}]
(-> file
(update :data (fn [fdata]
(-> fdata
(assoc :id id)
(dissoc :recent-colors)
(cond-> (> (:version fdata) cfd/version)
(assoc :version cfd/version))
;; FIXME: We're temporarily activating all
;; migrations because a problem in the
;; environments messed up with the version
;; numbers When this problem is fixed delete
;; the following line
(cond-> (> (:version fdata) 22)
(assoc :version 22)))))
(fmg/migrate-file)
(update :data (fn [fdata]
(-> fdata
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(update :colors relink-colors)
(d/without-nils))))))
(defn read-file!
[{:keys [::db/conn ::timestamp] :as cfg} file-id]
(l/trc :hint "read" :obj "file" :id (str file-id))
(sse/tap {:type :import-progress
:section :read-file
:id file-id})
(let [file (read-obj cfg :file file-id)
file (-> file
(update :id lookup-index)
(process-file))
;; All features that are enabled and requires explicit migration are
;; added to the state for a posterior migration step.
_ (doseq [feature (-> (::features cfg)
(set/difference cfeat/no-migration-features)
(set/difference (:features file)))]
(vswap! *state* update :pending-to-migrate (fnil conj []) [feature (:id file)]))
file (-> file
(update :project-id lookup-index))
file (-> file
(assoc :created-at timestamp)
(assoc :modified-at timestamp)
(update :features
(fn [features]
(let [features (cfeat/check-supported-features! features)]
(-> (::features cfg)
(set/difference cfeat/frontend-only-features)
(set/union features))))))
_ (when (contains? cf/flags :file-schema-validation)
(fval/validate-file-schema! file))
_ (when (contains? cf/flags :soft-file-schema-validation)
(let [result (ex/try! (fval/validate-file-schema! file))]
(when (ex/exception? result)
(l/error :hint "file schema validation error" :cause result))))
file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
file (if (contains? (:features file) "fdata/pointer-map")
(binding [pmap/*tracked* (pmap/create-tracked)]
(let [file (feat.fdata/enable-pointer-map file)]
(feat.fdata/persist-pointers! cfg (:id file))
file))
file)]
(db/insert! conn :file
(-> file
(update :features db/encode-pgarray conn "text")
(update :data blob/encode))
{::db/return-keys false}))
(doseq [thumbnail (read-seq cfg :file-object-thumbnail file-id)]
(let [thumbnail (-> thumbnail
(update :file-id lookup-index)
(update :media-id lookup-index))
file-id (:file-id thumbnail)
thumbnail (update thumbnail :object-id
#(str/replace-first % #"^(.*?)/" (str file-id "/")))]
(db/insert! conn :file-tagged-object-thumbnail thumbnail
{::db/return-keys false})))
(doseq [rel (read-obj cfg :file-rels file-id)]
(let [rel (-> rel
(update :file-id lookup-index)
(update :library-file-id lookup-index)
(assoc :synced-at timestamp))]
(db/insert! conn :file-library-rel rel
::db/return-keys false)))
(doseq [media (read-seq cfg :file-media-object file-id)]
(let [media (-> media
(update :id lookup-index)
(update :file-id lookup-index)
(update :media-id lookup-index)
(update :thumbnail-id lookup-index))]
(db/insert! conn :file-media-object media
::db/return-keys false))))
(def ^:private empty-summary
{:teams #{}
:files #{}
:projects #{}
:file-media-objects #{}
:team-font-variants #{}
:storage-objects #{}})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn export-team!
[cfg team-id]
(let [id (uuid/next)
tp (dt/tpoint)
cfg (-> (create-database cfg)
(update ::sto/storage media/configure-assets-storage))]
(l/inf :hint "start"
:operation "export"
:id (str id)
:path (str (::path cfg)))
(try
(db/tx-run! cfg (fn [cfg]
(setup-schema! cfg)
(binding [*state* (volatile! empty-summary)]
(write-team! cfg team-id)
(run! (partial write-project! cfg)
(get-team-projects cfg team-id))
(run! (partial write-file! cfg)
(get-team-files cfg team-id))
(run! (partial write-storage-object! cfg)
(-> *state* deref :storage-objects))
(write! cfg :manifest "team-id" team-id)
(write! cfg :manifest "objects" (deref *state*))
(::path cfg))))
(finally
(pu/close! (::db cfg))
(let [elapsed (tp)]
(l/inf :hint "end"
:operation "export"
:id (str id)
:elapsed (dt/format-duration elapsed)))))))
;; NOTE: will be used in future, commented for satisfy linter
;; (defn- run-pending-migrations!
;; [cfg]
;; ;; Run all pending migrations
;; (doseq [[feature file-id] (-> *state* deref :pending-to-migrate)]
;; (case feature
;; "components/v2"
;; (feat.compv2/migrate-file! cfg file-id :validate? (::validate cfg true))
;; (ex/raise :type :internal
;; :code :no-migration-defined
;; :hint (str/ffmt "no migation for feature '%' on file importation" feature)
;; :feature feature))))
(defn import-team!
[cfg path]
(let [id (uuid/next)
tp (dt/tpoint)
cfg (-> (create-database cfg path)
(update ::sto/storage media/configure-assets-storage)
(assoc ::timestamp (dt/now)))]
(l/inf :hint "start"
:operation "import"
:id (str id)
:path (str (::path cfg)))
(try
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(db/exec-one! conn ["SET idle_in_transaction_session_timeout = 0"])
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
(binding [*state* (volatile! {:index {}})]
(let [objects (read-obj cfg :manifest "objects")]
;; We first process all storage objects, they have
;; deduplication so we can't rely on simple reindex. This
;; operation populates the index for all storage objects.
(run! (partial read-storage-object! cfg) (:storage-objects objects))
;; Populate index with all the incoming objects
(vswap! *state* update :index
(fn [index]
(-> index
(update-index (:teams objects))
(update-index (:projects objects))
(update-index (:files objects))
(update-index (:file-media-objects objects))
(update-index (:team-font-variants objects)))))
(let [team-id (read-obj cfg :manifest "team-id")
team (read-team! cfg team-id)
features (cfeat/get-team-enabled-features cf/flags team)
cfg (assoc cfg ::features features)]
(run! (partial read-project! cfg) (:projects objects))
(run! (partial read-file! cfg) (:files objects))
;; (run-pending-migrations! cfg)
team)))))
(finally
(pu/close! (::db cfg))
(let [elapsed (tp)]
(l/inf :hint "end"
:operation "import"
:id (str id)
:elapsed (dt/format-duration elapsed)))))))

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

@ -493,6 +493,10 @@
(.createArrayOf conn ^String type (into-array Object objects))
(.createArrayOf conn ^String type objects))))
(defn encode-pgarray
[data conn type]
(create-array conn type data))
(defn decode-pgpoint
[^PGpoint v]
(gpt/point (.-x v) (.-y v)))
@ -518,7 +522,7 @@
(.rollback conn)))
([conn ^Savepoint sp]
(let [^Connection conn (get-connection conn)]
(l/trc :hint "explicit rollback requested")
(l/trc :hint "explicit rollback requested (savepoint)")
(.rollback conn sp))))
(defn tx-run!
@ -538,7 +542,7 @@
(release! conn sp)
result)
(catch Throwable cause
(rollback! conn sp)
(.rollback ^Connection conn ^Savepoint sp)
(throw cause))))
(::pool system)
@ -550,7 +554,7 @@
result))
:else
(throw (IllegalArgumentException. "invalid arguments"))))
(throw (IllegalArgumentException. "invalid system/cfg provided"))))
(defn run!
[system f & params]

23
backend/src/app/features/components_v2.clj
View file

@ -316,7 +316,25 @@
(dissoc component :objects))
component))]
(-> file-data
(update :components update-vals fix-component))))]
(update :components update-vals fix-component))))
fix-false-copies
(fn [file-data]
;; Find component heads that are not main-instance but have not :shape-ref.
(letfn [(fix-container
[container]
(update container :objects update-vals fix-shape))
(fix-shape
[shape]
(if (and (ctk/instance-head? shape)
(not (ctk/main-instance? shape))
(not (ctk/in-component-copy? shape)))
(ctk/detach-shape shape)
shape))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))]
(-> file-data
(fix-orphan-shapes)
@ -328,7 +346,8 @@
(transform-to-frames)
(remap-frame-ids)
(fix-frame-ids)
(fix-component-nil-objects))))
(fix-component-nil-objects)
(fix-false-copies))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS MIGRATION

18
backend/src/app/features/fdata.clj
View file

@ -30,6 +30,24 @@
(update :components update-vals update-fn))))
(update :features conj "fdata/objects-map"))))
(defn process-objects
"Apply a function to all objects-map on the file. Usualy used for convert
the objects-map instances to plain maps"
[fdata update-fn]
(let [update-container
(fn [container]
(d/update-when container :objects
(fn [objects]
(if (omap/objects-map? objects)
(update-fn objects)
objects))))]
(cond-> fdata
(contains? fdata :pages-index)
(update :pages-index update-vals update-container)
(contains? fdata :components)
(update :components update-vals update-container))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; POINTER-MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

40
backend/src/app/srepl/binfile.clj Normal file
View file

@ -0,0 +1,40 @@
;; 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.srepl.binfile
(:require
[app.binfile.v2 :as binfile.v2]
[app.db :as db]
[app.main :as main]
[cuerdas.core :as str]))
(defn export-team!
[team-id]
(let [team-id (if (string? team-id)
(parse-uuid team-id)
team-id)]
(binfile.v2/export-team! main/system team-id)))
(defn import-team!
[path & {:keys [owner rollback?] :or {rollback? true}}]
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [cfg]
(let [team (binfile.v2/import-team! cfg path)
owner (cond
(string? owner)
(db/get* cfg :profile {:email (str/lower owner)})
(uuid? owner)
(db/get* cfg :profile {:id owner}))]
(when owner
(db/insert! cfg :team-profile-rel
{:team-id (:id team)
:profile-id (:id owner)
:is-admin true
:is-owner true
:can-edit true}))
team))))

14
backend/src/app/storage.clj
View file

@ -19,7 +19,9 @@
[clojure.spec.alpha :as s]
[datoteka.fs :as fs]
[integrant.core :as ig]
[promesa.core :as p]))
[promesa.core :as p])
(:import
java.io.InputStream))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Storage Module State
@ -76,10 +78,15 @@
(defn- create-database-object
[{:keys [::backend ::db/pool-or-conn]} {:keys [::content ::expired-at ::touched-at] :as params}]
(let [id (uuid/random)
(let [id (or (:id params) (uuid/random))
mdata (cond-> (get-metadata params)
(satisfies? impl/IContentHash content)
(assoc :hash (impl/get-hash content)))
(assoc :hash (impl/get-hash content))
:always
(dissoc :id))
;; FIXME: touch object on deduplicated put operation ??
;; NOTE: for now we don't reuse the deleted objects, but in
;; futute we can consider reusing deleted objects if we
@ -175,6 +182,7 @@
(defn get-object-data
"Return an input stream instance of the object content."
^InputStream
[storage object]
(us/assert! ::storage storage)
(when (or (nil? (:expired-at object))

29
common/src/app/common/types/file.cljc
View file

@ -182,7 +182,7 @@
[file page libraries shape & {:keys [include-deleted?] :or {include-deleted? false}}]
(let [root-shape (ctn/get-copy-root (:objects page) shape)
component-file (when root-shape
(if (= (:component-file root-shape) (:id file))
(if (and (some? file) (= (:component-file root-shape) (:id file)))
file
(get libraries (:component-file root-shape))))
component (when component-file
@ -193,7 +193,7 @@
(if (some? ref-shape) ; There is a case when we have a nested orphan copy. In this case there is no near
ref-shape ; component for this copy, so shape-ref points to the remote main.
(let [head-shape (ctn/get-head-shape (:objects page) shape)
head-file (if (= (:component-file head-shape) (:id file))
head-file (if (and (some? file) (= (:component-file head-shape) (:id file)))
file
(get libraries (:component-file head-shape)))
head-component (when (some? head-file)
@ -571,18 +571,22 @@
(let [root-shape (ctn/get-component-shape objects shape)
component-file-id (when root-shape (:component-file root-shape))
component-file (when component-file-id (get libraries component-file-id nil))
component-shape (find-ref-shape file
{:objects objects}
libraries
shape
:include-deleted? true)]
component-shape (find-ref-shape file
{:objects objects}
libraries
shape
:include-deleted? true)]
(str/format " %s--> %s%s%s%s%s"
(cond (:component-root shape) "#"
(:component-id shape) "@"
:else "-")
(when component-file (str/format "<%s> " (:name component-file)))
(when (and (:component-file shape) component-file)
(str/format "<%s> "
(if (= (:id component-file) (:id file))
"local"
(:name component-file))))
(or (:name component-shape)
(str/format "?%s"
@ -603,7 +607,10 @@
(ctkl/get-component (:data component-file) component-id true)
(ctkl/get-component (:data file) component-id true))]
(str/format " (%s%s)"
(when component-file (str/format "<%s> " (:name component-file)))
(when component-file (str/format "<%s> "
(if (= (:id component-file) (:id file))
"local"
(:name component-file))))
(:name component))))
(when (and show-ids (:component-id shape))
@ -760,12 +767,12 @@
(if (nil? root)
(println (str "Cannot find shape " shape-id))
(do
(dump-page page file libraries (assoc flags :root-id (:id root)))
(dump-page page file libraries* (assoc flags :root-id (:id root)))
(dorun (for [[library-id component-ids] libs-to-show]
(let [library (get libraries* library-id)]
(dump-library library
file
libraries
libraries*
(assoc flags
:only component-ids
:include-deleted? true))

4
frontend/deps.edn
View file

@ -19,8 +19,8 @@
:git/url "https://github.com/funcool/beicon.git"}
funcool/rumext
{:git/tag "v2.9.3"
:git/sha "9047337"
{:git/tag "v2.9.4"
:git/sha "af08e55"
:git/url "https://github.com/funcool/rumext.git"}
instaparse/instaparse {:mvn/version "1.4.12"}

2
frontend/resources/styles/common/refactor/basic-rules.scss
View file

@ -161,7 +161,7 @@
svg,
span svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
}
}

3
frontend/resources/styles/common/refactor/color-defs.scss
View file

@ -16,6 +16,7 @@
--dark-gray-4: #34393b;
--white: #fff;
--off-white: #aab5ba;
--off-white-40: #{color.change(#aab5ba, $alpha: 0.4)};
--green: #91fadb;
--green-30: rgba(145, 250, 219, 0.3);
--lilac: #bb97d8;
@ -38,7 +39,7 @@
--light-gray-4: #eef0f2;
--black: #000;
--off-black: #495e74;
--off-black-30: #{color.change(#495e74, $alpha: 0.3)};
--off-black-40: #{color.change(#495e74, $alpha: 0.4)};
--purple: #6911d4;
--purple-30: rgba(105, 17, 212, 0.2);
--blue: #1345aa;

4
frontend/resources/styles/common/refactor/design-tokens.scss
View file

@ -23,8 +23,8 @@
--button-background-color-focus: var(--color-background-secondary);
--button-foreground-color-focus: var(--color-foreground-primary);
--button-border-color-focus: var(--color-accent-primary);
--button-foreground-color-disabled: var(--color-foreground-secondary);
--button-background-color-disabled: var(--color-foreground-disabled);
--button-foreground-color-disabled: var(--color-foreground-disabled);
--button-background-color-disabled: var(--color-background-quaternary);
--button-border-color-disabled: var(--color-background-quaternary);
--button-primary-background-color-rest: var(--color-accent-primary);

2
frontend/resources/styles/common/refactor/themes/default-theme.scss
View file

@ -16,7 +16,7 @@
--color-foreground-primary: var(--white);
--color-foreground-secondary: var(--off-white);
--color-foreground-tertiary: var(--pink);
--color-foreground-disabled: var(--dark-gray-4);
--color-foreground-disabled: var(--off-white-40);
--color-accent-primary: var(--green);
--color-accent-primary-muted: var(--green-30);
--color-accent-secondary: var(--lilac);

4
frontend/resources/styles/common/refactor/themes/light-theme.scss
View file

@ -16,7 +16,7 @@
--color-foreground-primary: var(--black);
--color-foreground-secondary: var(--off-black);
--color-foreground-tertiary: var(--pink);
--color-foreground-disabled: var(--off-black-30);
--color-foreground-disabled: var(--off-black-40);
--color-accent-primary: var(--purple);
--color-accent-primary-muted: var(--purple-30);
--color-accent-secondary: var(--blue);
@ -29,7 +29,7 @@
--error-color: var(--light-error-color);
--canvas-color: var(--color-canvas);
--shadow-color: var(--off-black-30);
--shadow-color: var(--off-black-40);
--radio-button-box-shadow: 0 0 0 1px var(--light-gray-2) inset;
@include meta.load-css("hljs-light-theme");

6
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -566,11 +566,12 @@
(let [file (wsh/get-local-file state)
page-id (get state :current-page-id)
container (cfh/get-container file :page page-id)
libraries (wsh/get-libraries state)
changes (-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects (:objects container))
(dwlh/generate-detach-instance container id))]
(dwlh/generate-detach-instance container libraries id))]
(rx/of (dch/commit-changes changes))))))
@ -595,13 +596,14 @@
objects (wsh/lookup-page-objects state page-id)
file (wsh/get-local-file state)
container (cfh/get-container file :page page-id)
libraries (wsh/get-libraries state)
selected (->> state
(wsh/lookup-selected)
(cfh/clean-loops objects))
changes (reduce
(fn [changes id]
(dwlh/generate-detach-instance changes container id))
(dwlh/generate-detach-instance changes libraries container id))
(-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects objects))

47
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -200,31 +200,46 @@
[new-shape changes])))
(declare generate-detach-recursive)
(declare generate-advance-nesting-level)
(defn generate-detach-instance
"Generate changes to remove the links between a shape and all its children
with a component."
[changes container shape-id]
[changes container libraries shape-id]
(let [shape (ctn/get-shape container shape-id)]
(log/debug :msg "Detach instance" :shape-id shape-id :container (:id container))
(generate-detach-recursive changes container shape-id true (true? (:component-root shape)))))
(generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape)))))
(defn- generate-detach-recursive
[changes container shape-id first component-root?]
[changes container libraries shape-id first component-root?]
(let [shape (ctn/get-shape container shape-id)]
(if (and (ctk/instance-head? shape) (not first))
;; Subinstances are not detached
(if component-root?
;; if the original shape was component-root, the subinstances are converted in top instances
(pcb/update-shapes changes [(:id shape)] #(assoc % :component-root true))
changes)
; Subinstances are not detached
(cond-> changes
component-root?
; If the initial shape was component-root, first level subinstances are converted in top instances
(pcb/update-shapes [shape-id] #(assoc % :component-root true))
:always
; Near shape-refs need to be advanced one level
(generate-advance-nesting-level nil container libraries (:id shape)))
;; Otherwise, detach the shape and all children
(let [children-ids (:shapes shape)]
(reduce #(generate-detach-recursive %1 container %2 false component-root?)
(reduce #(generate-detach-recursive %1 container libraries %2 false component-root?)
(pcb/update-shapes changes [(:id shape)] ctk/detach-shape)
children-ids)))))
(defn- generate-advance-nesting-level
[changes file container libraries shape-id]
(let [children (cfh/get-children-with-self (:objects container) shape-id)
skip-near (fn [changes shape]
(let [ref-shape (ctf/find-ref-shape file container libraries shape {:include-deleted? true})]
(if (some? (:shape-ref ref-shape))
(pcb/update-shapes changes [(:id shape)] #(assoc % :shape-ref (:shape-ref ref-shape)))
changes)))]
(reduce skip-near changes children)))
(defn prepare-restore-component
([library-data component-id current-page it]
(let [component (ctkl/get-deleted-component library-data component-id)
@ -232,9 +247,9 @@
(when (some #(= (:id current-page) %) (:pages library-data)) ;; If the page doesn't belong to the library, it's not valid
current-page)
(ctpl/get-last-page library-data))]
(prepare-restore-component nil library-data component-id it page (gpt/point 0 0) nil nil)))
(prepare-restore-component nil library-data component-id it page (gpt/point 0 0) nil nil nil)))
([changes library-data component-id it page delta old-id parent-id]
([changes library-data component-id it page delta old-id parent-id frame-id]
(let [component (ctkl/get-deleted-component library-data component-id)
parent (get-in page [:objects parent-id])
inside-component? (some? (ctn/get-instance-root (:objects page) parent))
@ -244,9 +259,11 @@
first-shape (cond-> (first shapes)
(not (nil? parent-id))
(assoc :parent-id parent-id)
(and parent (= :frame (:type parent)))
(not (nil? frame-id))
(assoc :frame-id frame-id)
(and (nil? frame-id) parent (= :frame (:type parent)))
(assoc :frame-id parent-id)
(and parent (not= :frame (:type parent)))
(and (nil? frame-id) parent (not= :frame (:type parent)))
(assoc :frame-id (:frame-id parent))
inside-component?
(dissoc :component-root)
@ -604,7 +621,7 @@
;; deleted or the library unlinked, do nothing in v2 or detach in v1.
(if components-v2
changes
(generate-detach-instance changes container shape-id))))
(generate-detach-instance changes libraries container shape-id))))
changes)))
(defn- find-main-container
@ -634,7 +651,7 @@
;; This should not occur, but protect against it in any case
(if components-v2
changes
(generate-detach-instance changes container (:id shape-inst)))
(generate-detach-instance changes container {(:id library) library} (:id shape-inst)))
(let [omit-touched? (not reset?)
clear-remote-synced? (and initial-root? reset?)
set-remote-synced? (and (not initial-root?) reset?)

2
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -418,7 +418,7 @@
frame-id)
restore-component
#(let [restore (dwlh/prepare-restore-component changes library-data (:component-id component-root) it page delta (:id component-root) parent-id)]
#(let [restore (dwlh/prepare-restore-component changes library-data (:component-id component-root) it page delta (:id component-root) parent-id frame-id)]
[(:shape restore) (:changes restore)])
[_shape changes]

37
frontend/src/app/main/ui/components/forms.cljs
View file

@ -202,17 +202,15 @@
:on-change on-change)
(obj/clj->props))]
[:div.custom-input
{:class klass}
[:*
[:label label]
[:> :textarea props]
(cond
(and touched? (:message error))
[:span.error (tr (:message error))]
[:div {:class (dm/str klass " " (stl/css :textarea-wrapper))}
[:label {:class (stl/css :textarea-label)} label]
[:> :textarea props]
(cond
(and touched? (:message error))
[:span {:class (stl/css :error)} (tr (:message error))]
(string? hint)
[:span.hint hint])]]))
(string? hint)
[:span {:class (stl/css :hint)} hint])]))
(mf/defc select
[{:keys [options disabled form default] :as props
@ -287,13 +285,13 @@
(mf/defc submit-button*
{::mf/wrap-props false}
[{:keys [on-click children label form class-name name disabled] :as props}]
[{:keys [on-click children label form class name disabled] :as props}]
(let [form (or form (mf/use-ctx form-ctx))
disabled? (or (and (some? form) (not (:valid @form)))
(true? disabled))
class (dm/str (d/nilv class-name "btn-primary btn-large")
class (dm/str (d/nilv class "btn-primary btn-large")
" "
(if disabled? (stl/css :btn-disabled) ""))
@ -307,14 +305,13 @@
(on-click event))))
props
(-> (obj/clone props)
(obj/set! "children" mf/undefined)
(obj/set! "disabled" disabled?)
(obj/set! "onKeyDown" on-key-down)
(obj/set! "name" name)
(obj/set! "label" mf/undefined)
(obj/set! "className" class)
(obj/set! "type" "submit"))]
(mf/spread-props props {:children mf/undefined
:disabled disabled?
:on-key-down on-key-down
:name name
:labek mf/undefined
:class class
:type "submit"})]
[:> "button" props
(if (some? children)

27
frontend/src/app/main/ui/components/forms.scss
View file

@ -72,7 +72,6 @@
}
}
}
&.valid .help-icon,
&.invalid .help-icon {
right: $s-40;
@ -98,6 +97,7 @@
height: $s-16;
}
}
.invalid-icon {
width: $s-16;
height: $s-16;
@ -261,7 +261,6 @@
}
// MULTI INPUT
.custom-multi-input {
display: flex;
flex-direction: column;
@ -338,19 +337,9 @@
}
}
}
&.empty {
}
&.invalid {
}
&.focus {
}
&.valid {
}
}
// RADIO BUTTONS
.custom-radio {
display: grid;
grid-template-columns: repeat(3, 1fr);
@ -410,3 +399,17 @@
border: $s-1 solid var(--input-border-color-active);
}
}
//TEXTAREA
.textarea-label {
@include tabTitleTipography;
color: var(--modal-title-foreground-color);
text-transform: uppercase;
margin-bottom: $s-8;
}
.textarea-wrapper {
display: grid;
grid-template-rows: auto 1fr;
}

8
frontend/src/app/main/ui/components/radio_buttons.scss
View file

@ -53,19 +53,19 @@
cursor: default;
background-color: transparent;
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
.title-name {
color: var(--button-background-color-disabled);
color: var(--button-foreground-color-disabled);
}
&:hover {
border: none;
background-color: transparent;
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
.title-name {
color: var(--button-background-color-disabled);
color: var(--button-foreground-color-disabled);
}
}
}

2
frontend/src/app/main/ui/workspace/color_palette.scss
View file

@ -46,7 +46,7 @@
}
&:disabled {
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
&::after {
background-image: none;

10
frontend/src/app/main/ui/workspace/sidebar/assets/typographies.cljs
View file

@ -109,17 +109,17 @@
:on-drop on-drop}
[:& typography-entry
{:typography typography
{:file-id file-id
:typography typography
:local? local?
:on-context-menu on-context-menu
:on-change handle-change
:selected? (contains? selected typography-id)
:on-click on-asset-click
:on-change handle-change
:on-context-menu on-context-menu
:editing? editing?
:renaming? renaming?
:focus-name? rename?
:external-open* open*
:file-id file-id}]
:external-open* open*}]
(when ^boolean dragging?
[:div {:class (stl/css :dragging)}])]))

4
frontend/src/app/main/ui/workspace/sidebar/options/menus/align.scss
View file

@ -29,12 +29,12 @@
&.disabled {
cursor: default;
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
&:hover {
background-color: var(--panel-background-color);
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
}
}

4
frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.scss
View file

@ -30,12 +30,12 @@
&.disabled {
cursor: default;
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
&:hover {
background-color: var(--panel-background-color);
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
}
}

6
frontend/src/app/main/ui/workspace/sidebar/options/menus/component.cljs
View file

@ -488,7 +488,11 @@
:collapsed (not open?)
:on-collapsed toggle-content
:title (tr "workspace.options.component")
:class (stl/css :title-spacing-component)}])]
:class (stl/css :title-spacing-component)}
[:span {:class (stl/css :copy-text)}
(if main-instance?
(tr "workspace.options.component.main")
(tr "workspace.options.component.copy"))]])]
(when open?
[:div {:class (stl/css :element-content)}

8
frontend/src/app/main/ui/workspace/sidebar/options/menus/component.scss
View file

@ -34,6 +34,14 @@
}
}
.copy-text {
@include titleTipography;
height: 100%;
display: flex;
align-items: center;
color: var(--title-foreground-color);
}
.component-icon {
@include flexCenter;
height: $s-24;

18
frontend/src/app/main/ui/workspace/sidebar/options/menus/text.cljs
View file

@ -204,8 +204,8 @@
(mf/deps more-options-open?)
#(swap! state* assoc-in [:more-options] (not more-options-open?)))
typography-id (:typography-ref-id values)
typography-file (:typography-ref-file values)
typography-id (:typography-ref-id values)
typography-file-id (:typography-ref-file values)
emit-update!
(mf/use-fn
@ -228,14 +228,14 @@
(cond
(and typography-id
(not= typography-id :multiple)
(not= typography-file file-id))
(not= typography-file-id file-id))
(-> shared-libs
(get-in [typography-file :data :typographies typography-id])
(assoc :file-id typography-file))
(get-in [typography-file-id :data :typographies typography-id])
(assoc :file-id typography-file-id))
(and typography-id
(not= typography-id :multiple)
(= typography-file file-id))
(= typography-file-id file-id))
(get typographies typography-id))))
on-convert-to-typography
@ -297,9 +297,9 @@
[:div {:class (stl/css :element-content)}
(cond
typography
[:& typography-entry {:typography typography
:local? (= typography-file file-id)
:file (get shared-libs typography-file)
[:& typography-entry {:file-id typography-file-id
:typography typography
:local? (= typography-file-id file-id)
:on-detach handle-detach-typography
:on-change handle-change-typography}]

7
frontend/src/app/main/ui/workspace/text_palette.scss
View file

@ -44,7 +44,7 @@
}
&:disabled {
svg {
stroke: var(--button-background-color-disabled);
stroke: var(--button-foreground-color-disabled);
}
&::after {
background-image: none;
@ -93,25 +93,28 @@
&:first-child {
margin-left: $s-8;
}
.typography-name {
@include tabTitleTipography;
@include textEllipsis;
height: $s-16;
width: $s-120;
color: var(--palette-text-color-selected);
}
.typography-font {
@include textEllipsis;
height: $s-16;
width: $s-120;
color: var(--palette-text-color);
}
.typography-data {
@include textEllipsis;
height: $s-16;
width: $s-120;
color: var(--palette-text-color);
}
&.mid-item {
.typography-name {
height: $s-16;