📚 Update changelog

Co-authored-by: Xavier Julian <xaviju@proton.me>

.circleci/config.yml

@@ -263,6 +263,12 @@ jobs:
           command: |
             cargo fmt --check
 
+      - run:
+          name: "lint"
+          working_directory: "./render-wasm"
+          command: |
+            ./lint
+
       - run:
           name: "cargo tests"
           working_directory: "./render-wasm"

.github/PULL_REQUEST_TEMPLATE.md

@@ -1,29 +1,19 @@
-<!--
+### Related Ticket
 
-Some key notes before you open a PR:
+<!-- Reference the related GitHub/Taiga ticket. -->
 
- 1. Select which branch should this PR be merged in? By default, you should always merge to the develop branch.
- 2. PR name follows [convention](http://karma-runner.github.io/4.0/dev/git-commit-msg.html)
- 3. All tests pass locally, UI and Unit tests
- 4. All business logic and validations must be on the server-side
- 5. Update necessary Documentation
- 6. Put `closes #XXXX` in your comment to auto-close the issue that your PR fixes
+### Summary
 
+### Steps to reproduce 
 
-Also, if you're new here
+### Checklist
 
-- Contribution Guide => https://github.com/uxbox/uxbox/blob/develop/CONTRIBUTING.md
+- [ ] Choose the correct target branch; use `develop` by default.
+- [ ] Provide a brief summary of the changes introduced.
+- [ ] Add a detailed explanation of how to reproduce the issue and/or verify the fix, if applicable.
+- [ ] Include screenshots or videos, if applicable.
+- [ ] Add or modify existing integration tests in case of bugs or new features, if applicable.
+- [ ] Check CI passes successfully.
+- [ ] Update the `CHANGES.md` file, referencing the related GitHub issue, if applicable.
 
--->
-
-> Please provide enough information so that others can review your pull request:
-
-<!-- You can skip this if you're fixing a typo or updating existing documentation -->
-
-> Explain the **details** for making this change. What existing problem does the pull request solve?
-
-<!-- Example: When "Adding a function to do X", explain why it is necessary to have a way to do X. -->
-
-> Screenshots/GIFs
-
-<!-- Add images/recordings to better visualize the change: expected/current behviour -->
+<!-- For more details, check the contribution guidelines: https://github.com/penpot/penpot/blob/develop/CONTRIBUTING.md -->

CHANGES.md

@@ -1,8 +1,84 @@
 # CHANGELOG
 
+## 2.6.2
+
+### :bug: Bugs fixed
+
+- Increase the height of the right sidebar dropdowns [Taiga #10615](https://tree.taiga.io/project/penpot/issue/10615)
+- Fix scroll on token themes modal [Taiga #10745](https://tree.taiga.io/project/penpot/issue/10745)
+- Fix collapsing grouped sets in "edit Theme" closes the dialog [Taiga #10771](https://tree.taiga.io/project/penpot/issue/10771)
+- Fix unexpected exception on path editor on merge segments when undo stack is empty
+- Fix pricing CTA to be under a config flag [Taiga #10808](https://tree.taiga.io/project/penpot/issue/10808)
+- Fix allow moving a main component into another [Taiga #10818](https://tree.taiga.io/project/penpot/issue/10818)
+- Fix several issues with internal srepl helpers
+- Fix unexpected exception on template import from libraries
+- Fix incorrect uuid parsing from different parts of code
+- Fix update layout on component restore [Taiga #10637](https://tree.taiga.io/project/penpot/issue/10637)
+- Fix horizontal scroll in viewer [Github #6290](https://github.com/penpot/penpot/issues/6290)
+- Fix detach component in a particular case [Taiga #10837](https://tree.taiga.io/project/penpot/issue/10837)
+
+## 2.6.1
+
+### :bug: Bugs fixed
+
+- Fix webhooks not shown in list [Taiga #10763](https://tree.taiga.io/project/penpot/issue/10763)
+- Fix colorpicker scroll when dropdown displayed [Taiga #10696](https://tree.taiga.io/project/penpot/issue/10696)
+- Clean internal workspace state on exit or url changed [Taiga #10619](https://tree.taiga.io/project/penpot/issue/10619)
+
+## 2.6.0
+
+### :rocket: Epics and highlights
+
+- Design Tokens
+
+### :boom: Breaking changes & Deprecations
+
+### :heart: Community contributions (Thank you!)
+
+### :sparkles: New features
+
+- [COMMENTS] "Mark All as Read" Functionality in Dashboard [Taiga #9235](https://tree.taiga.io/project/penpot/us/9235)
+- [COMMENTS] Bubble Groups [Taiga #9236](https://tree.taiga.io/project/penpot/us/9236)
+- Change templates carrousel [Taiga #9803](https://tree.taiga.io/project/penpot/us/9803)
+- [DESIGN TOKENS] Tokens CRUD. Types added: Color, Opacity, Border radius, Dimension, Sizing, Spacing, Rotation and Stroke.
+- [DESIGN TOKENS] Create references (alias) that point to other tokens.
+- [DESIGN TOKENS] Math operations in token values.
+- [DESIGN TOKENS] Sets CRUD, grouping and reordering.
+- [DESIGN TOKENS] Multidimensional Themes and Sets management.
+- [DESIGN TOKENS] Apply/Remove tokens to/from elements from the Tokens tab.
+- [DESIGN TOKENS] Integration with components.
+- [DESIGN TOKENS] Import and export tokens from a JSON file.
+- [DESIGN TOKENS] Apply Themes and Sets at document level.
+- Add more descriptive tooltip to boards for first time users [Taiga #9426](https://tree.taiga.io/project/penpot/us/9426)
+- First State of a Project Changes Consolidation [Taia #10605](https://tree.taiga.io/project/penpot/us/10605)
+
+### :bug: Bugs fixed
+
+- Fix opacity in frame containers [Github #5858](https://github.com/penpot/penpot/pull/5858)
+- Avoid resizing on click [Taiga #10213](https://tree.taiga.io/project/penpot/issue/10213)
+- Hide horizontal scroll from dashboard sidebar [Taiga #10422](https://tree.taiga.io/project/penpot/issue/10422)
+- Fix cut and paste a copy a cmponent inside its parent [Taiga #10365](https://tree.taiga.io/project/penpot/us/10365)
+- Fix duplicate page with component over frame [Taiga #8151](https://tree.taiga.io/project/penpot/issue/8151) and [Taiga #9698](https://tree.taiga.io/project/penpot/issue/9698)
+- The plugin list in the navigation menu lacks scrolling, some plugins are not visible when a large number are installed [Taiga #9360](https://tree.taiga.io/project/penpot/us/9360)
+- Fix hidden toolbar click event still available [Taiga #10437](https://tree.taiga.io/project/penpot/us/10437)
+- Fix hovering over templates [Taiga #10545](https://tree.taiga.io/project/penpot/issue/10545)
+- Fix problem with default shadows value in plugins [Plugins #191](https://github.com/penpot/penpot-plugins/issues/191)
+- Fix problem with constraints when creating group [Taiga #10455](https://tree.taiga.io/project/penpot/issue/10455)
+- Fix opening pen with shortcut multiple times breaks toolbar [Taiga #10566](https://tree.taiga.io/project/penpot/issue/10566)
+- Fix actions when workspace is visited first time [Taiga #10548](https://tree.taiga.io/project/penpot/issue/10548)
+- Chat icon overlaps "Show" button in carrousel section [Taiga #10542](https://tree.taiga.io/project/penpot/issue/10542)
+- Fix assets name on inspect tab [Taiga #10630](https://tree.taiga.io/project/penpot/issue/10630)
+- Fix chat icon overlaps "Show" button in carrousel section [Taiga #10542](https://tree.taiga.io/project/penpot/issue/10542)
+- Fix incorrect handling of background task result (now task rows are properly marked as completed)
+- Fix available size of resize handler [Taiga #10639](https://tree.taiga.io/project/penpot/issue/10639)
+- Internal error when install a plugin by penpothub - Try plugin [Taiga #10542](https://tree.taiga.io/project/penpot/issue/10542)
+- Add character limitation to asset inputs [Taiga #10669](https://tree.taiga.io/project/penpot/issue/10669)
+- Fix Storybook link 'list of all available icons' wrong path [Taiga #10705](https://tree.taiga.io/project/penpot/issue/10705)
+
+
 ## 2.5.4
 
-### :sparkles: New features
+### :heart: Community contributions (Thank you!)
 
 - Add support for WEBP format on shape export [Github #6053](https://github.com/penpot/penpot/pull/6053) and [Github #6074](https://github.com/penpot/penpot/pull/6074)
 
@@ -86,6 +162,7 @@ is a number of cores)
 
 ### :bug: Bugs fixed
 
+- Fix menu shadow color [Taiga #10102](https://tree.taiga.io/project/penpot/issue/10102)
 - Fix missing state refresh on notifications update [Taiga #10253](https://tree.taiga.io/project/penpot/issue/10253)
 - Fix icon visualization on select component [Taiga #8889](https://tree.taiga.io/project/penpot/issue/8889)
 - Fix typo on integration tests docs [Taiga #10112](https://tree.taiga.io/project/penpot/issue/10112)

backend/package.json

@@ -4,7 +4,7 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.6.0+sha512.5383cc12567a95f1d668fbe762dfe0075c595b4bfff433be478dbbe24e05251a8e8c3eb992a986667c1d53b6c3a9c85b8398c35a960587fbd9fa3a0915406728",
+  "packageManager": "yarn@4.8.1+sha512.bc946f2a022d7a1a38adfc15b36a66a3807a67629789496c3714dd1703d2e6c6b1c69ff9ec3b43141ac7a1dd853b7685638eb0074300386a59c18df351ef8ff6",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"

backend/resources/app/templates/debug.tmpl

@@ -151,6 +151,78 @@ Debug Main Page
         </div>
 
 
+        <div class="row">
+          <input type="submit" value="Submit" />
+        </div>
+      </form>
+    </fieldset>
+  </section>
+
+  <section class="widget">
+    <h2>Feature Flags</h2>
+    <fieldset>
+      <legend>Enable</legend>
+      <desc>Add a feature flag to a team</desc>
+      <form method="post" action="/dbg/actions/add-team-feature">
+        <div class="row">
+          <input type="text" style="width:300px" name="team-id" placeholder="team-id" />
+        </div>
+        <div class="row">
+          <input type="text" style="width:100px" name="feature" placeholder="feature" value="" />
+        </div>
+
+        <div class="row">
+          <label for="check-feature">Skip feature check</label>
+          <input id="check-feature" type="checkbox" name="skip-check" />
+          <br />
+          <small>
+            Do not check if the feature is supported
+          </small>
+        </div>
+
+        <div class="row">
+          <label for="force-version">Are you sure?</label>
+          <input id="force-version" type="checkbox" name="force" />
+          <br />
+          <small>
+            This is a just a security double check for prevent non intentional submits.
+          </small>
+        </div>
+
+        <div class="row">
+          <input type="submit" value="Submit" />
+        </div>
+      </form>
+    </fieldset>
+    <fieldset>
+      <legend>Disable</legend>
+      <desc>Remove a feature flag from a team</desc>
+      <form method="post" action="/dbg/actions/remove-team-feature">
+        <div class="row">
+          <input type="text" style="width:300px" name="team-id" placeholder="team-id" />
+        </div>
+        <div class="row">
+          <input type="text" style="width:100px" name="feature" placeholder="feature" value="" />
+        </div>
+
+        <div class="row">
+          <label for="check-feature">Skip feature check</label>
+          <input id="check-feature" type="checkbox" name="skip-check" />
+          <br />
+          <small>
+            Do not check if the feature is supported
+          </small>
+        </div>
+
+        <div class="row">
+          <label for="force-version">Are you sure?</label>
+          <input id="force-version" type="checkbox" name="force" />
+          <br />
+          <small>
+            This is a just a security double check for prevent non intentional submits.
+          </small>
+        </div>
+
         <div class="row">
           <input type="submit" value="Submit" />
         </div>

backend/scripts/repl

@@ -30,7 +30,8 @@ export PENPOT_FLAGS="\
        enable-access-tokens \
        enable-tiered-file-data-storage \
        enable-file-validation \
-       enable-file-schema-validation";
+       enable-file-schema-validation \
+       enable-subscriptions-old";
 
 # Default deletion delay for devenv
 export PENPOT_DELETION_DELAY="24h"

backend/scripts/start-dev

@@ -23,7 +23,8 @@ export PENPOT_FLAGS="\
        enable-access-tokens \
        enable-tiered-file-data-storage \
        enable-file-validation \
-       enable-file-schema-validation";
+       enable-file-schema-validation \
+       enable-subscriptions-old";
 
 export OPTIONS="
        -A:jmx-remote -A:dev \

backend/src/app/binfile/cleaner.clj

@@ -0,0 +1,44 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.binfile.cleaner
+  "A collection of helpers for perform cleaning of artifacts; mainly
+  for recently imported shapes."
+  (:require
+   [app.common.data :as d]
+   [app.common.uuid :as uuid]))
+
+(defn- fix-shape-shadow-color
+  "Some shapes can come with invalid `id` property on shadow colors
+  caused by incorrect uuid parsing bug that should be already fixed;
+  this function removes the invalid id from the data structure."
+  [shape]
+  (let [fix-color
+        (fn [{:keys [id] :as color}]
+          (if (uuid? id)
+            color
+            (if (and (string? id)
+                     (re-matches uuid/regex id))
+              (assoc color :id (uuid/uuid id))
+              (dissoc color :id))))
+
+        fix-shadow
+        (fn [shadow]
+          (d/update-when shadow :color fix-color))
+
+        xform
+        (map fix-shadow)]
+
+    (d/update-when shape :shadow
+                   (fn [shadows]
+                     (into [] xform shadows)))))
+
+(defn clean-shape-post-decode
+  "A shape procesor that expected to be executed after schema decoding
+  process but before validation."
+  [shape]
+  (-> shape
+      (fix-shape-shadow-color)))

backend/src/app/binfile/migrations.clj

@@ -39,6 +39,11 @@
       "fdata/shape-data-type"
       nil
 
+      ;; There is no migration needed, but we don't want to allow
+      ;; copy paste nor import of variant files into no-variant teams
+      "variants/v1"
+      nil
+
       (ex/raise :type :internal
                 :code :no-migration-defined
                 :hint (str/ffmt "no migation for feature '%' on file importation" feature)

backend/src/app/binfile/v3.clj

@@ -8,12 +8,14 @@
   "A ZIP based binary file exportation"
   (:refer-clojure :exclude [read])
   (:require
+   [app.binfile.cleaner :as bfl]
    [app.binfile.common :as bfc]
    [app.binfile.migrations :as bfm]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
+   [app.common.files.migrations :as-alias fmg]
    [app.common.json :as json]
    [app.common.logging :as l]
    [app.common.schema :as sm]
@@ -594,16 +596,25 @@
 
 (defn- read-file-components
   [{:keys [::bfc/input ::file-id ::entries]}]
-  (->> (keep (match-component-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-component)
-                                   (validate-component))]
-                   (if (= id (:id object))
-                     (assoc result id object)
-                     result)))
-               {})
-       (not-empty)))
+  (let [clean-component-post-decode
+        (fn [component]
+          (d/update-when component :objects
+                         (fn [objects]
+                           (reduce-kv (fn [objects id shape]
+                                        (assoc objects id (bfl/clean-shape-post-decode shape)))
+                                      objects
+                                      objects))))]
+    (->> (keep (match-component-entry-fn file-id) entries)
+         (reduce (fn [result {:keys [id entry]}]
+                   (let [object (->> (read-entry input entry)
+                                     (decode-component)
+                                     (clean-component-post-decode)
+                                     (validate-component))]
+                     (if (= id (:id object))
+                       (assoc result id object)
+                       result)))
+                 {})
+         (not-empty))))
 
 (defn- read-file-typographies
   [{:keys [::bfc/input ::file-id ::entries]}]
@@ -631,7 +642,9 @@
        (reduce (fn [result {:keys [id entry]}]
                  (let [object (->> (read-entry input entry)
                                    (decode-shape)
+                                   (bfl/clean-shape-post-decode)
                                    (validate-shape))]
+
                    (if (= id (:id object))
                      (assoc result id object)
                      result)))
@@ -733,7 +746,14 @@
                    (assoc :name file-name)
                    (assoc :project-id project-id)
                    (dissoc :options)
-                   (bfc/process-file))]
+                   (bfc/process-file)
+
+                   ;; NOTE: this is necessary because when we just
+                   ;; creating a new file from imported artifact,
+                   ;; there are no migrations registered on the
+                   ;; database, so we need to persist all of them, not
+                   ;; only the applied
+                   (vary-meta dissoc ::fmg/migrated))]
 
 
       (bfm/register-pending-migrations! cfg file)

backend/src/app/db.clj

@@ -22,7 +22,8 @@
    [clojure.set :as set]
    [integrant.core :as ig]
    [next.jdbc :as jdbc]
-   [next.jdbc.date-time :as jdbc-dt])
+   [next.jdbc.date-time :as jdbc-dt]
+   [next.jdbc.transaction])
   (:import
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
@@ -223,16 +224,6 @@
     (let [^OutputStream os (.getOutputStream ^LargeObject lobj)]
       (io/make-output-stream os opts))))
 
-(defmacro with-atomic
-  [& args]
-  (if (symbol? (first args))
-    (let [cfgs (first args)
-          body (rest args)]
-      `(jdbc/with-transaction [conn# (::pool ~cfgs)]
-         (let [~cfgs (assoc ~cfgs ::conn conn#)]
-           ~@body)))
-    `(jdbc/with-transaction ~@args)))
-
 (defn open
   [system-or-pool]
   (if (pool? system-or-pool)
@@ -535,43 +526,31 @@
      (l/trc :hint "explicit rollback requested (savepoint)")
      (.rollback conn sp))))
 
+(defn transact!
+  "A lower-level function for executing function in a transaction"
+  ([transactable f] (transact! transactable f {}))
+  ([transactable f opts]
+   (binding [next.jdbc.transaction/*nested-tx* :ignore]
+     (jdbc/transact transactable f opts))))
+
 (defn tx-run!
+  "Run a function in a transaction."
   [system f & params]
-  (cond
-    (connection? system)
+  (if (connection? system)
     (tx-run! {::conn system} f)
-
-    (pool? system)
-    (tx-run! {::pool system} f)
-
-    (::conn system)
-    (let [conn (::conn system)
-          sp   (savepoint conn)]
-      (try
-        (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)
-          (throw cause))))
-
-    (::pool system)
-    (with-atomic [conn (::pool system)]
-      (let [system' (-> system
-                        (assoc ::conn conn)
-                        (dissoc ::rollback))
-            result  (apply f system' params)]
-        (when (::rollback system)
-          (rollback! conn))
-        result))
-
-    :else
-    (throw (IllegalArgumentException. "invalid system/cfg provided"))))
+    (if (pool? system)
+      (tx-run! {::pool system} f)
+      (if-let [conn (or (::conn system)
+                        (::pool system))]
+        (transact! conn
+                   (fn [conn]
+                     (let [system' (-> system
+                                       (dissoc ::rollback)
+                                       (assoc ::conn conn))]
+                       (apply f system' params)))
+                   {:rollback-only (::rollback system)
+                    :read-only (::read-only system)})
+        (throw (IllegalArgumentException. "invalid system/cfg provided"))))))
 
 (defn run!
   [system f & params]

backend/src/app/features/components_v2.clj

@@ -1071,7 +1071,7 @@
         groups (d/group-by #(first (cfh/split-path (:path %))) assets)
         ;; If there is a group called as the generic-name we have to preserve it
         unames (into #{} (keep str) (keys groups))
-        groups (rename-keys groups {generic-name (cfh/generate-unique-name unames generic-name)})
+        groups (rename-keys groups {generic-name (cfh/generate-unique-name generic-name unames)})
 
         ;; Split large groups in chunks of max-group-size elements
         groups (loop [groups (seq groups)

backend/src/app/http.clj

@@ -155,10 +155,10 @@
    [["" {:middleware [[mw/server-timing]
                       [mw/params]
                       [mw/format-response]
-                      [mw/parse-request]
-                      [mw/errors errors/handle]
                       [session/soft-auth cfg]
                       [actoken/soft-auth cfg]
+                      [mw/parse-request]
+                      [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
      (::mtx/routes cfg)

backend/src/app/http/debug.clj

@@ -24,7 +24,7 @@
    [app.rpc.commands.profile :as profile]
    [app.rpc.commands.teams :as teams]
    [app.setup :as-alias setup]
-   [app.srepl.helpers :as srepl]
+   [app.srepl.main :as srepl]
    [app.storage :as-alias sto]
    [app.storage.tmp :as tmp]
    [app.util.blob :as blob]
@@ -430,6 +430,50 @@
      ::yres/body    "OK"}))
 
 
+(defn- add-team-feature
+  [{:keys [params] :as request}]
+  (let [team-id (some-> params :team-id d/parse-uuid)
+        feature (some-> params :feature str)
+        skip-check (contains? params :skip-check)]
+
+    (when-not (contains? params :force)
+      (ex/raise :type :validation
+                :code :missing-force
+                :hint "missing force checkbox"))
+
+    (when (nil? team-id)
+      (ex/raise :type :validation
+                :code :invalid-team-id
+                :hint "provided invalid team id"))
+
+    (srepl/enable-team-feature! team-id feature :skip-check skip-check)
+
+    {::yres/status  200
+     ::yres/headers {"content-type" "text/plain"}
+     ::yres/body    "OK"}))
+
+(defn- remove-team-feature
+  [{:keys [params] :as request}]
+  (let [team-id   (some-> params :team-id d/parse-uuid)
+        feature   (some-> params :feature str)
+        skip-check (contains? params :skip-check)]
+
+    (when-not (contains? params :force)
+      (ex/raise :type :validation
+                :code :missing-force
+                :hint "missing force checkbox"))
+
+    (when (nil? team-id)
+      (ex/raise :type :validation
+                :code :invalid-team-id
+                :hint "provided invalid team id"))
+
+    (srepl/disable-team-feature! team-id feature :skip-check skip-check)
+
+    {::yres/status  200
+     ::yres/headers {"content-type" "text/plain"}
+     ::yres/body    "OK"}))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; OTHER SMALL VIEWS/HANDLERS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -500,6 +544,10 @@
      {:handler (partial resend-email-notification cfg)}]
     ["/actions/reset-file-version"
      {:handler (partial reset-file-version cfg)}]
+    ["/actions/add-team-feature"
+     {:handler (partial add-team-feature)}]
+    ["/actions/remove-team-feature"
+     {:handler (partial remove-team-feature)}]
     ["/file/export" {:handler (partial export-handler cfg)}]
     ["/file/import" {:handler (partial import-handler cfg)}]
     ["/file/data" {:handler (partial file-data-handler cfg)}]

backend/src/app/http/errors.clj

@@ -25,7 +25,6 @@
   (let [claims (-> {}
                    (into (::session/token-claims request))
                    (into (::actoken/token-claims request)))]
-
     {:request/path       (:path request)
      :request/method     (:method request)
      :request/params     (:params request)
@@ -62,7 +61,8 @@
        ::yres/body data}
 
       (binding [l/*context* (request->context request)]
-        (l/err :hint "restriction error" :data data)
+        (l/err :hint "restriction error"
+               :cause err)
         {::yres/status 400
          ::yres/body data}))))
 
@@ -102,7 +102,7 @@
       (= code :invalid-image)
       (binding [l/*context* (request->context request)]
         (let [cause (or parent-cause err)]
-          (l/warn :hint "unexpected error on processing image" :cause cause)
+          (l/warn :hint "image process error" :cause cause)
           {::yres/status 400 ::yres/body data}))
 
       :else
@@ -177,7 +177,7 @@
   (let [state (.getSQLState ^java.sql.SQLException error)
         cause (or parent-cause error)]
     (binding [l/*context* (request->context request)]
-      (l/error :hint "PSQL error"
+      (l/error :hint "postgresql error"
                :cause cause)
       (cond
         (= state "57014")

backend/src/app/http/session.clj

@@ -337,16 +337,17 @@
        or (updated_at is null and
            created_at < now() - ?::interval)")
 
-(defmethod ig/init-key ::tasks/gc
-  [_ {:keys [::db/pool ::tasks/max-age] :as cfg}]
-  (l/debug :hint "initializing session gc task" :max-age max-age)
-  (fn [_]
-    (db/with-atomic [conn pool]
-      (let [interval (db/interval max-age)
-            result   (db/exec-one! conn [sql:delete-expired interval interval])
-            result   (:next.jdbc/update-count result)]
-        (l/debug :task "gc"
-                 :hint "clean http sessions"
-                 :deleted result)
-        result))))
+(defn- collect-expired-tasks
+  [{:keys [::db/conn ::tasks/max-age]}]
+  (let [interval (db/interval max-age)
+        result   (db/exec-one! conn [sql:delete-expired interval interval])
+        result   (:next.jdbc/update-count result)]
+    (l/debug :task "gc"
+             :hint "clean http sessions"
+             :deleted result)
+    result))
 
+(defmethod ig/init-key ::tasks/gc
+  [_ {:keys [::tasks/max-age] :as cfg}]
+  (l/debug :hint "initializing session gc task" :max-age max-age)
+  (fn [_] (db/tx-run! cfg collect-expired-tasks)))

backend/src/app/http/websocket.clj

@@ -273,7 +273,7 @@
 
 (defn- http-handler
   [cfg {:keys [params ::session/profile-id] :as request}]
-  (let [session-id (some-> params :session-id sm/parse-uuid)]
+  (let [session-id (some-> params :session-id uuid/parse*)]
     (when-not (uuid? session-id)
       (ex/raise :type :validation
                 :code :missing-session-id

backend/src/app/loggers/database.clj

@@ -53,11 +53,16 @@
                    (assoc :logger/name logger)
                    (assoc :logger/level level)
                    (dissoc :request/params :value :params :data))]
+
       (merge
        {:context (-> (into (sorted-map) ctx)
                      (pp/pprint-str :length 50))
         :props   (pp/pprint-str props :length 50)
-        :hint    (or (ex-message cause) @message)
+        :hint    (or (when-let [message (ex-message cause)]
+                       (if-let [props-hint (:hint props)]
+                         (str props-hint ": " message)
+                         message))
+                     @message)
         :trace   (or (::trace record)
                      (some-> cause (ex/format-throwable :data? false :explain? false :header? false :summary? false)))}
 

backend/src/app/rpc/commands/access_token.clj

@@ -43,13 +43,8 @@
     (decode-row token)))
 
 (defn repl:create-access-token
-  [{:keys [::db/pool] :as system} profile-id name expiration]
-  (db/with-atomic [conn pool]
-    (let [props (:app.setup/props system)]
-      (create-access-token {::db/conn conn ::setup/props props}
-                           profile-id
-                           name
-                           expiration))))
+  [cfg profile-id name expiration]
+  (db/tx-run! cfg create-access-token profile-id name expiration))
 
 (def ^:private schema:create-access-token
   [:map {:title "create-access-token"}

backend/src/app/rpc/commands/auth.clj

@@ -55,7 +55,7 @@
                 (contains? cf/flags :login-with-password))
     (ex/raise :type :restriction
               :code :login-disabled
-              :hint "login is disabled in this instance"))
+              :hint "login is disabled"))
 
   (letfn [(check-password [cfg profile password]
             (if (= (:password profile) "!")
@@ -79,7 +79,8 @@
                         :code :wrong-credentials))
             (when (:is-blocked profile)
               (ex/raise :type :restriction
-                        :code :profile-blocked))
+                        :code :profile-blocked
+                        :hint "profile is marked as blocked"))
             (when-not (check-password cfg profile password)
               (ex/raise :type :validation
                         :code :wrong-credentials))
@@ -149,7 +150,7 @@
 ;; ---- COMMAND: Recover Profile
 
 (defn recover-profile
-  [{:keys [::db/pool] :as cfg} {:keys [token password]}]
+  [{:keys [::db/conn] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
             (let [tdata (tokens/verify (::setup/props cfg) {:token token :iss :password-recovery})]
               (:profile-id tdata)))
@@ -159,10 +160,10 @@
               (db/update! conn :profile {:password pwd :is-active true} {:id profile-id})
               nil))]
 
-    (db/with-atomic [conn pool]
-      (->> (validate-token token)
-           (update-password conn))
-      nil)))
+    (->> (validate-token token)
+         (update-password conn))
+
+    nil))
 
 (def schema:recover-profile
   [:map {:title "recover-profile"}
@@ -173,7 +174,8 @@
   {::rpc/auth false
    ::doc/added "1.15"
    ::sm/params schema:recover-profile
-   ::climit/id :auth/global}
+   ::climit/id :auth/global
+   ::db/transaction true}
   [cfg params]
   (recover-profile cfg params))
 
@@ -182,11 +184,11 @@
 (defn- validate-register-attempt!
   [cfg params]
 
-  (when (or
-         (not (contains? cf/flags :registration))
-         (not (contains? cf/flags :login-with-password)))
+  (when (or (not (contains? cf/flags :registration))
+            (not (contains? cf/flags :login-with-password)))
     (ex/raise :type :restriction
-              :code :registration-disabled))
+              :code :registration-disabled
+              :hint "registration disabled"))
 
   (when (contains? params :invitation-token)
     (let [invitation (tokens/verify (::setup/props cfg)
@@ -200,12 +202,14 @@
   (when (and (email.blacklist/enabled? cfg)
              (email.blacklist/contains? cfg (:email params)))
     (ex/raise :type :restriction
-              :code :email-domain-is-not-allowed))
+              :code :email-domain-is-not-allowed
+              :hint "email domain in blacklist"))
 
   (when (and (email.whitelist/enabled? cfg)
              (not (email.whitelist/contains? cfg (:email params))))
     (ex/raise :type :restriction
-              :code :email-domain-is-not-allowed))
+              :code :email-domain-is-not-allowed
+              :hint "email domain not in whitelist"))
 
   ;; Perform a basic validation of email & password
   (when (= (str/lower (:email params))
@@ -218,13 +222,13 @@
     (ex/raise :type :restriction
               :code :email-has-permanent-bounces
               :email (:email params)
-              :hint "looks like the email has bounce reports"))
+              :hint "email has bounce reports"))
 
   (when (eml/has-complaint-reports? cfg (:email params))
     (ex/raise :type :restriction
               :code :email-has-complaints
               :email (:email params)
-              :hint "looks like the email has complaint reports")))
+              :hint "email has complaint reports")))
 
 (defn prepare-register
   [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]

backend/src/app/rpc/commands/binfile.clj

@@ -38,7 +38,6 @@
 (def ^:private
   schema:export-binfile
   [:map {:title "export-binfile"}
-   [:name [:string {:max 250}]]
    [:file-id ::sm/uuid]
    [:version {:optional true} ::sm/int]
    [:include-libraries ::sm/boolean]
@@ -78,7 +77,7 @@
   "Export a penpot file in a binary format."
   {::doc/added "1.15"
    ::webhooks/event? true
-   ::sm/result schema:export-binfile}
+   ::sm/params schema:export-binfile}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id version file-id] :as params}]
   (files/check-read-permissions! pool profile-id file-id)
   (fn [_]

backend/src/app/rpc/commands/comments.clj

@@ -797,3 +797,18 @@
                 {:id id}
                 {::db/return-keys false})
     nil))
+
+(def ^:private
+  schema:mark-all-threads-as-read
+  [:map {:title "mark-all-threads-as-read"}
+   [:threads [:vector ::sm/uuid]]])
+
+(sv/defmethod ::mark-all-threads-as-read
+  {::doc/added "1.15"
+   ::sm/params schema:mark-all-threads-as-read}
+  [cfg {:keys [::rpc/profile-id threads] :as params}]
+  (db/tx-run!
+   cfg
+   (fn [{:keys [::db/conn]}]
+     (doseq [thread-id threads]
+       (upsert-comment-thread-status! conn profile-id thread-id)))))

backend/src/app/rpc/commands/demo.clj

@@ -27,7 +27,7 @@
   {::rpc/auth false
    ::doc/added "1.15"
    ::doc/changes ["1.15" "This method is migrated from mutations to commands."]}
-  [{:keys [::db/pool] :as cfg} _]
+  [cfg _]
 
   (when-not (contains? cf/flags :demo-users)
     (ex/raise :type :validation
@@ -49,9 +49,11 @@
                   :password (profile/derive-password cfg password)
                   :props {}}]
 
-    (db/with-atomic [conn pool]
-      (let [profile (->> (auth/create-profile! conn params)
-                         (auth/create-profile-rels! conn))]
-        (with-meta {:email email
-                    :password password}
-          {::audit/profile-id (:id profile)})))))
+
+    (let [profile (db/tx-run! cfg (fn [{:keys [::db/conn]}]
+                                    (->> (auth/create-profile! conn params)
+                                         (auth/create-profile-rels! conn))))]
+      (with-meta {:email email
+                  :password password}
+        {::audit/profile-id (:id profile)}))))
+

backend/src/app/rpc/commands/files.clj

@@ -292,7 +292,7 @@
 
 (defn get-file-etag
   [{:keys [::rpc/profile-id]} {:keys [modified-at revn vern permissions]}]
-  (str profile-id "/" revn "/" vern "/"
+  (str profile-id "/" revn "/" vern "/" (hash fmg/available-migrations) "/"
        (dt/format-instant modified-at :iso)
        "/"
        (uri/map->query-string permissions)))
@@ -328,7 +328,7 @@
 
       (-> (cfeat/get-team-enabled-features cf/flags team)
           (cfeat/check-client-features! (:features params))
-          (cfeat/check-file-features! (:features file) (:features params)))
+          (cfeat/check-file-features! (:features file)))
 
       ;; This operation is needed for backward comapatibility with frontends that
       ;; does not support pointer-map resolution mechanism; this just resolves the
@@ -490,7 +490,7 @@
 
         _    (-> (cfeat/get-team-enabled-features cf/flags team)
                  (cfeat/check-client-features! (:features params))
-                 (cfeat/check-file-features! (:features file) (:features params)))
+                 (cfeat/check-file-features! (:features file)))
 
         page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
                (let [page-id (or page-id (-> file :data :pages first))
@@ -737,7 +737,7 @@
 
     (-> (cfeat/get-team-enabled-features cf/flags team)
         (cfeat/check-client-features! (:features params))
-        (cfeat/check-file-features! (:features file) (:features params)))
+        (cfeat/check-file-features! (:features file)))
 
     (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
       {:name             (:name file)
@@ -806,17 +806,17 @@
     [:id ::sm/uuid]
     [:name [:string {:max 250}]]
     [:created-at ::dt/instant]
-    [:modified-at ::dt/instant]]}
+    [:modified-at ::dt/instant]]
 
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (let [file (rename-file conn params)]
-      (rph/with-meta
-        (select-keys file [:id :name :created-at :modified-at])
-        {::audit/props {:project-id (:project-id file)
-                        :created-at (:created-at file)
-                        :modified-at (:modified-at file)}}))))
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  (check-edition-permissions! conn profile-id id)
+  (let [file (rename-file conn params)]
+    (rph/with-meta
+      (select-keys file [:id :name :created-at :modified-at])
+      {::audit/props {:project-id (:project-id file)
+                      :created-at (:created-at file)
+                      :modified-at (:modified-at file)}})))
 
 ;; --- MUTATION COMMAND: set-file-shared
 
@@ -1008,15 +1008,17 @@
   {::doc/added "1.17"
    ::webhooks/event? true
    ::sm/params schema:link-file-to-library}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id library-id] :as params}]
+  [cfg {:keys [::rpc/profile-id file-id library-id] :as params}]
   (when (= file-id library-id)
     (ex/raise :type :validation
               :code :invalid-library
               :hint "A file cannot be linked to itself"))
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id)
-    (check-edition-permissions! conn profile-id library-id)
-    (link-file-to-library conn params)))
+
+  (db/tx-run! cfg
+              (fn [{:keys [::db/conn]}]
+                (check-edition-permissions! conn profile-id file-id)
+                (check-edition-permissions! conn profile-id library-id)
+                (link-file-to-library conn params))))
 
 ;; --- MUTATION COMMAND: unlink-file-from-library
 
@@ -1034,12 +1036,12 @@
 (sv/defmethod ::unlink-file-from-library
   {::doc/added "1.17"
    ::webhooks/event? true
-   ::sm/params schema:unlink-file-to-library}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id)
-    (unlink-file-from-library conn params)
-    nil))
+   ::sm/params schema:unlink-file-to-library
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (check-edition-permissions! conn profile-id file-id)
+  (unlink-file-from-library conn params)
+  nil)
 
 ;; --- MUTATION COMMAND: update-sync
 
@@ -1059,12 +1061,11 @@
 (sv/defmethod ::update-file-library-sync-status
   "Update the synchronization status of a file->library link"
   {::doc/added "1.17"
-   ::sm/params schema:update-file-library-sync-status}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id)
-    (update-sync conn params)))
-
+   ::sm/params schema:update-file-library-sync-status
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id file-id] :as params}]
+  (check-edition-permissions! conn profile-id file-id)
+  (update-sync conn params))
 
 ;; --- MUTATION COMMAND: ignore-sync
 
@@ -1085,9 +1086,9 @@
 (sv/defmethod ::ignore-file-library-sync-status
   "Ignore updates in linked files"
   {::doc/added "1.17"
-   ::sm/params schema:ignore-file-library-sync-status}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id)
-    (->  (ignore-sync conn params)
-         (update :features db/decode-pgarray #{}))))
+   ::sm/params schema:ignore-file-library-sync-status
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id file-id] :as params}]
+  (check-edition-permissions! conn profile-id file-id)
+  (->  (ignore-sync conn params)
+       (update :features db/decode-pgarray #{})))

backend/src/app/rpc/commands/files_create.clj

@@ -91,9 +91,6 @@
                                  :project-id project-id)
         team-id  (:id team)
 
-        ;; When we create files, we only need to respect the team
-        ;; features, because some features can be enabled
-        ;; globally, but the team is still not migrated properly.
         features (-> (cfeat/get-team-enabled-features cf/flags team)
                      (cfeat/check-client-features! (:features params)))
 
@@ -107,7 +104,7 @@
 
         params   (-> params
                      (assoc :profile-id profile-id)
-                     (assoc :features (set/difference features cfeat/frontend-only-features)))]
+                     (assoc :features features))]
 
     (quotes/check! cfg {::quotes/id ::quotes/files-per-project
                         ::quotes/team-id team-id
@@ -120,7 +117,7 @@
     ;; to lost team features updating
 
     ;; When newly computed features does not match exactly with
-    ;; the features defined on team row, we update it.
+    ;; the features defined on team row, we update it
     (when (not= features (:features team))
       (let [features (db/create-array conn "text" features)]
         (db/update! conn :team

backend/src/app/rpc/commands/files_share.clj

@@ -33,11 +33,11 @@
   pages of a file with specific permissions (who-comment and who-inspect)."
   {::doc/added "1.18"
    ::doc/module :files
-   ::sm/params schema:create-share-link}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (files/check-edition-permissions! conn profile-id file-id)
-    (create-share-link conn (assoc params :profile-id profile-id))))
+   ::sm/params schema:create-share-link
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id file-id] :as params}]
+  (files/check-edition-permissions! conn profile-id file-id)
+  (create-share-link conn (assoc params :profile-id profile-id)))
 
 (defn create-share-link
   [conn {:keys [profile-id file-id pages who-comment who-inspect]}]
@@ -61,10 +61,10 @@
 (sv/defmethod ::delete-share-link
   {::doc/added "1.18"
    ::doc/module ::files
-   ::sm/params schema:delete-share-link}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [slink (db/get-by-id conn :share-link id)]
-      (files/check-edition-permissions! conn profile-id (:file-id slink))
-      (db/delete! conn :share-link {:id id})
-      nil)))
+   ::sm/params schema:delete-share-link
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id id] :as params}]
+  (let [slink (db/get-by-id conn :share-link id)]
+    (files/check-edition-permissions! conn profile-id (:file-id slink))
+    (db/delete! conn :share-link {:id id})
+    nil))

backend/src/app/rpc/commands/files_thumbnails.clj

@@ -180,8 +180,7 @@
 (def ^:private
   schema:get-file-data-for-thumbnail
   [:map {:title "get-file-data-for-thumbnail"}
-   [:file-id ::sm/uuid]
-   [:features {:optional true} ::cfeat/features]])
+   [:file-id ::sm/uuid]])
 
 (def ^:private
   schema:partial-file
@@ -211,8 +210,7 @@
                                       (fmg/migrate-file)))]
 
                    (-> (cfeat/get-team-enabled-features cf/flags team)
-                       (cfeat/check-client-features! (:features params))
-                       (cfeat/check-file-features! (:features file) (:features params)))
+                       (cfeat/check-file-features! (:features file)))
 
                    {:file-id file-id
                     :revn (:revn file)

backend/src/app/rpc/commands/files_update.clj

@@ -142,7 +142,7 @@
 
                           features (-> (cfeat/get-team-enabled-features cf/flags team)
                                        (cfeat/check-client-features! (:features params))
-                                       (cfeat/check-file-features! (:features file) (:features params)))
+                                       (cfeat/check-file-features! (:features file)))
 
                           changes  (if changes-with-metadata
                                      (->> changes-with-metadata (mapcat :changes) vec)

backend/src/app/rpc/commands/management.clj

@@ -396,45 +396,49 @@
 ;; --- COMMAND: Clone Template
 
 (defn clone-template
-  [cfg {:keys [project-id profile-id] :as params} template]
-  (db/tx-run! cfg (fn [{:keys [::db/conn ::wrk/executor] :as cfg}]
-                    ;; NOTE: the importation process performs some operations
-                    ;; that are not very friendly with virtual threads, and for
-                    ;; avoid unexpected blocking of other concurrent operations
-                    ;; we dispatch that operation to a dedicated executor.
-                    (let [template (tmp/tempfile-from template
-                                                      :prefix "penpot.template."
-                                                      :suffix ""
-                                                      :min-age "30m")
+  [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [project-id profile-id] :as params} template]
 
-                          format   (bfc/parse-file-format template)
-                          team     (teams/get-team conn
-                                                   :profile-id profile-id
-                                                   :project-id project-id)
-                          cfg      (-> cfg
-                                       (assoc ::bfc/project-id project-id)
-                                       (assoc ::bfc/profile-id profile-id)
-                                       (assoc ::bfc/input template)
-                                       (assoc ::bfc/features (cfeat/get-team-enabled-features cf/flags team)))
+  ;; NOTE: the importation process performs some operations
+  ;; that are not very friendly with virtual threads, and for
+  ;; avoid unexpected blocking of other concurrent operations
+  ;; we dispatch that operation to a dedicated executor.
+  (let [template (tmp/tempfile-from template
+                                    :prefix "penpot.template."
+                                    :suffix ""
+                                    :min-age "30m")
 
-                          result   (if (= format :binfile-v3)
-                                     (px/invoke! executor (partial bf.v3/import-files! cfg))
-                                     (px/invoke! executor (partial bf.v1/import-files! cfg)))]
+        format   (bfc/parse-file-format template)
+        team     (teams/get-team pool
+                                 :profile-id profile-id
+                                 :project-id project-id)
 
-                      (db/update! conn :project
-                                  {:modified-at (dt/now)}
-                                  {:id project-id})
+        cfg      (-> cfg
+                     (assoc ::bfc/project-id project-id)
+                     (assoc ::bfc/profile-id profile-id)
+                     (assoc ::bfc/input template)
+                     (assoc ::bfc/features (cfeat/get-team-enabled-features cf/flags team)))
 
-                      (let [props (audit/clean-props params)]
-                        (doseq [file-id result]
-                          (let [props (assoc props :id file-id)
-                                event (-> (audit/event-from-rpc-params params)
-                                          (assoc ::audit/profile-id profile-id)
-                                          (assoc ::audit/name "create-file")
-                                          (assoc ::audit/props props))]
-                            (audit/submit! cfg event))))
+        result   (if (= format :binfile-v3)
+                   (px/invoke! executor (partial bf.v3/import-files! cfg))
+                   (px/invoke! executor (partial bf.v1/import-files! cfg)))]
 
-                      result))))
+    (db/tx-run! cfg
+                (fn [{:keys [::db/conn] :as cfg}]
+                  (db/update! conn :project
+                              {:modified-at (dt/now)}
+                              {:id project-id}
+                              {::db/return-keys false})
+
+                  (let [props (audit/clean-props params)]
+                    (doseq [file-id result]
+                      (let [props (assoc props :id file-id)
+                            event (-> (audit/event-from-rpc-params params)
+                                      (assoc ::audit/profile-id profile-id)
+                                      (assoc ::audit/name "create-file")
+                                      (assoc ::audit/props props))]
+                        (audit/submit! cfg event))))))
+
+    result))
 
 (def ^:private
   schema:clone-template

backend/src/app/rpc/commands/media.clj

@@ -273,15 +273,14 @@
 
 (sv/defmethod ::clone-file-media-object
   {::doc/added "1.17"
-   ::sm/params schema:clone-file-media-object}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (files/check-edition-permissions! conn profile-id file-id)
-    (-> (assoc cfg :conn conn)
-        (clone-file-media-object params))))
+   ::sm/params schema:clone-file-media-object
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (files/check-edition-permissions! conn profile-id file-id)
+  (clone-file-media-object cfg params))
 
 (defn clone-file-media-object
-  [{:keys [conn]} {:keys [id file-id is-local]}]
+  [{:keys [::db/conn]} {:keys [id file-id is-local]}]
   (let [mobj (db/get-by-id conn :file-media-object id)]
     (db/insert! conn :file-media-object
                 {:id (uuid/next)

backend/src/app/rpc/commands/profile.clj

@@ -125,32 +125,32 @@
 (sv/defmethod ::update-profile
   {::doc/added "1.0"
    ::sm/params schema:update-profile
-   ::sm/result schema:profile}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
-  (db/with-atomic [conn pool]
-    ;; NOTE: we need to retrieve the profile independently if we use
-    ;; it or not for explicit locking and avoid concurrent updates of
-    ;; the same row/object.
-    (let [profile (-> (db/get-by-id conn :profile profile-id ::sql/for-update true)
-                      (decode-row))
+   ::sm/result schema:profile
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id fullname lang theme] :as params}]
+  ;; NOTE: we need to retrieve the profile independently if we use
+  ;; it or not for explicit locking and avoid concurrent updates of
+  ;; the same row/object.
+  (let [profile (-> (db/get-by-id conn :profile profile-id ::sql/for-update true)
+                    (decode-row))
 
-          ;; Update the profile map with direct params
-          profile (-> profile
-                      (assoc :fullname fullname)
-                      (assoc :lang lang)
-                      (assoc :theme theme))]
+        ;; Update the profile map with direct params
+        profile (-> profile
+                    (assoc :fullname fullname)
+                    (assoc :lang lang)
+                    (assoc :theme theme))]
 
-      (db/update! conn :profile
-                  {:fullname fullname
-                   :lang lang
-                   :theme theme
-                   :props (db/tjson (:props profile))}
-                  {:id profile-id})
+    (db/update! conn :profile
+                {:fullname fullname
+                 :lang lang
+                 :theme theme
+                 :props (db/tjson (:props profile))}
+                {:id profile-id})
 
-      (-> profile
-          (strip-private-attrs)
-          (d/without-nils)
-          (rph/with-meta {::audit/props (audit/profile->props profile)})))))
+    (-> profile
+        (strip-private-attrs)
+        (d/without-nils)
+        (rph/with-meta {::audit/props (audit/profile->props profile)}))))
 
 
 ;; --- MUTATION: Update Password
@@ -169,21 +169,20 @@
 (sv/defmethod ::update-profile-password
   {::doc/added "1.0"
    ::sm/params schema:update-profile-password
-   ::climit/id :auth/global}
+   ::climit/id :auth/global
+   ::db/transaction true}
   [cfg {:keys [::rpc/profile-id password] :as params}]
+  (let [profile    (validate-password! cfg (assoc params :profile-id profile-id))
+        session-id (::session/id params)]
 
-  (db/tx-run! cfg (fn [cfg]
-                    (let [profile    (validate-password! cfg (assoc params :profile-id profile-id))
-                          session-id (::session/id params)]
+    (when (= (:email profile) (str/lower (:password params)))
+      (ex/raise :type :validation
+                :code :email-as-password
+                :hint "you can't use your email as password"))
 
-                      (when (= (:email profile) (str/lower (:password params)))
-                        (ex/raise :type :validation
-                                  :code :email-as-password
-                                  :hint "you can't use your email as password"))
-
-                      (update-profile-password! cfg (assoc profile :password password))
-                      (invalidate-profile-session! cfg profile-id session-id)
-                      nil))))
+    (update-profile-password! cfg (assoc profile :password password))
+    (invalidate-profile-session! cfg profile-id session-id)
+    nil))
 
 (defn- invalidate-profile-session!
   "Removes all sessions except the current one."
@@ -441,37 +440,36 @@
 (declare ^:private get-owned-teams)
 
 (sv/defmethod ::delete-profile
-  {::doc/added "1.0"}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [teams      (get-owned-teams conn profile-id)
-          deleted-at (dt/now)]
+  {::doc/added "1.0"
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  (let [teams      (get-owned-teams conn profile-id)
+        deleted-at (dt/now)]
 
-      ;; If we found owned teams with participants, we don't allow
-      ;; delete profile until the user properly transfer ownership or
-      ;; explicitly removes all participants from the team
-      (when (some pos? (map :participants teams))
-        (ex/raise :type :validation
-                  :code :owner-teams-with-people
-                  :hint "The user need to transfer ownership of owned teams."
-                  :context {:teams (mapv :id teams)}))
+    ;; If we found owned teams with participants, we don't allow
+    ;; delete profile until the user properly transfer ownership or
+    ;; explicitly removes all participants from the team
+    (when (some pos? (map :participants teams))
+      (ex/raise :type :validation
+                :code :owner-teams-with-people
+                :hint "The user need to transfer ownership of owned teams."
+                :context {:teams (mapv :id teams)}))
 
-      ;; Mark profile deleted immediatelly
-      (db/update! conn :profile
-                  {:deleted-at deleted-at}
-                  {:id profile-id})
+    ;; Mark profile deleted immediatelly
+    (db/update! conn :profile
+                {:deleted-at deleted-at}
+                {:id profile-id})
 
-      ;; Schedule cascade deletion to a worker
-      (wrk/submit! {::db/conn conn
-                    ::wrk/task :delete-object
-                    ::wrk/params {:object :profile
-                                  :deleted-at deleted-at
-                                  :id profile-id}})
+    ;; Schedule cascade deletion to a worker
+    (wrk/submit! {::db/conn conn
+                  ::wrk/task :delete-object
+                  ::wrk/params {:object :profile
+                                :deleted-at deleted-at
+                                :id profile-id}})
 
 
-      (-> (rph/wrap nil)
-          (rph/with-transform (session/delete-fn cfg))))))
-
+    (-> (rph/wrap nil)
+        (rph/with-transform (session/delete-fn cfg)))))
 
 ;; --- HELPERS
 

backend/src/app/rpc/commands/projects.clj

@@ -219,12 +219,12 @@
    ::sm/params schema:update-project-pin
    ::webhooks/batch-timeout (dt/duration "5s")
    ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id team-id is-pinned] :as params}]
-  (db/with-atomic [conn pool]
-    (check-read-permissions! conn profile-id id)
-    (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
-    nil))
+   ::webhooks/event? true
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id id team-id is-pinned] :as params}]
+  (check-read-permissions! conn profile-id id)
+  (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
+  nil)
 
 ;; --- MUTATION: Rename Project
 
@@ -238,17 +238,17 @@
 (sv/defmethod ::rename-project
   {::doc/added "1.18"
    ::sm/params schema:rename-project
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (let [project (db/get-by-id conn :project id ::sql/for-update true)]
-      (db/update! conn :project
-                  {:name name}
-                  {:id id})
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :prev-name (:name project)}}))))
+   ::webhooks/event? true
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id id name] :as params}]
+  (check-edition-permissions! conn profile-id id)
+  (let [project (db/get-by-id conn :project id ::sql/for-update true)]
+    (db/update! conn :project
+                {:name name}
+                {:id id})
+    (rph/with-meta (rph/wrap)
+      {::audit/props {:team-id (:team-id project)
+                      :prev-name (:name project)}})))
 
 ;; --- MUTATION: Delete Project
 
@@ -280,13 +280,13 @@
 (sv/defmethod ::delete-project
   {::doc/added "1.18"
    ::sm/params schema:delete-project
-   ::webhooks/event? true}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (let [project (delete-project conn id)]
-      (rph/with-meta (rph/wrap)
-        {::audit/props {:team-id (:team-id project)
-                        :name (:name project)
-                        :created-at (:created-at project)
-                        :modified-at (:modified-at project)}}))))
+   ::webhooks/event? true
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id id] :as params}]
+  (check-edition-permissions! conn profile-id id)
+  (let [project (delete-project conn id)]
+    (rph/with-meta (rph/wrap)
+      {::audit/props {:team-id (:team-id project)
+                      :name (:name project)
+                      :created-at (:created-at project)
+                      :modified-at (:modified-at project)}})))

backend/src/app/rpc/commands/teams.clj

@@ -527,14 +527,14 @@
 
 (sv/defmethod ::update-team
   {::doc/added "1.17"
-   ::sm/params schema:update-team}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (db/update! conn :team
-                {:name name}
-                {:id id})
-    nil))
+   ::sm/params schema:update-team
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id name]}]
+  (check-edition-permissions! conn profile-id id)
+  (db/update! conn :team
+              {:name name}
+              {:id id})
+  nil)
 
 
 ;; --- Mutation: Leave Team
@@ -592,10 +592,10 @@
 
 (sv/defmethod ::leave-team
   {::doc/added "1.17"
-   ::sm/params schema:leave-team}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (leave-team conn (assoc params :profile-id profile-id))))
+   ::sm/params schema:leave-team
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  (leave-team conn (assoc params :profile-id profile-id)))
 
 ;; --- Mutation: Delete Team
 
@@ -627,16 +627,16 @@
 
 (sv/defmethod ::delete-team
   {::doc/added "1.17"
-   ::sm/params schema:delete-team}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (get-permissions conn profile-id id)]
-      (when-not (:is-owner perms)
-        (ex/raise :type :validation
-                  :code :only-owner-can-delete-team))
+   ::sm/params schema:delete-team
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  (let [perms (get-permissions conn profile-id id)]
+    (when-not (:is-owner perms)
+      (ex/raise :type :validation
+                :code :only-owner-can-delete-team))
 
-      (delete-team conn id)
-      nil)))
+    (delete-team conn id)
+    nil))
 
 ;; --- Mutation: Team Update Role
 
@@ -714,31 +714,30 @@
 
 (sv/defmethod ::delete-team-member
   {::doc/added "1.17"
-   ::sm/params schema:delete-team-member}
-  [{:keys [::db/pool ::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [team  (get-team pool :profile-id profile-id :team-id team-id)
-          perms (get-permissions conn profile-id team-id)]
-      (when-not (or (:is-owner perms)
-                    (:is-admin perms))
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
+   ::sm/params schema:delete-team-member
+   ::db/transaction true}
+  [{:keys [::db/conn ::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
+  (let [team  (get-team conn :profile-id profile-id :team-id team-id)
+        perms (get-permissions conn profile-id team-id)]
+    (when-not (or (:is-owner perms)
+                  (:is-admin perms))
+      (ex/raise :type :validation
+                :code :insufficient-permissions))
 
-      (when (= member-id profile-id)
-        (ex/raise :type :validation
-                  :code :cant-remove-yourself))
+    (when (= member-id profile-id)
+      (ex/raise :type :validation
+                :code :cant-remove-yourself))
 
-      (db/delete! conn :team-profile-rel {:profile-id member-id
-                                          :team-id team-id})
+    (db/delete! conn :team-profile-rel {:profile-id member-id
+                                        :team-id team-id})
+    (mbus/pub! msgbus
+               :topic member-id
+               :message {:type :team-membership-change
+                         :change :removed
+                         :team-id team-id
+                         :team-name (:name team)})
 
-      (mbus/pub! msgbus
-                 :topic member-id
-                 :message {:type :team-membership-change
-                           :change :removed
-                           :team-id team-id
-                           :team-name (:name team)})
-
-      nil)))
+    nil))
 
 ;; --- Mutation: Update Team Photo
 
@@ -764,16 +763,16 @@
   (let [team  (get-team pool :profile-id profile-id :team-id team-id)
         photo (profile/upload-photo cfg params)]
 
-    (db/with-atomic [conn pool]
-      (check-admin-permissions! conn profile-id team-id)
-      ;; Mark object as touched for make it ellegible for tentative
-      ;; garbage collection.
-      (when-let [id (:photo-id team)]
-        (sto/touch-object! storage id))
+    (check-admin-permissions! pool profile-id team-id)
 
-      ;; Save new photo
-      (db/update! pool :team
-                  {:photo-id (:id photo)}
-                  {:id team-id})
+    ;; Mark object as touched for make it ellegible for tentative
+    ;; garbage collection.
+    (when-let [id (:photo-id team)]
+      (sto/touch-object! storage id))
 
-      (assoc team :photo-id (:id photo)))))
+    ;; Save new photo
+    (db/update! pool :team
+                {:photo-id (:id photo)}
+                {:id team-id})
+
+    (assoc team :photo-id (:id photo))))

backend/src/app/rpc/commands/teams_invitations.clj

@@ -408,20 +408,20 @@
 (sv/defmethod ::update-team-invitation-role
   {::doc/added "1.17"
    ::doc/module :teams
-   ::sm/params schema:update-team-invitation-role}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (teams/get-permissions conn profile-id team-id)]
+   ::sm/params schema:update-team-invitation-role
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id team-id email role] :as params}]
+  (let [perms (teams/get-permissions conn profile-id team-id)]
 
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
+    (when-not (:is-admin perms)
+      (ex/raise :type :validation
+                :code :insufficient-permissions))
 
-      (db/update! conn :team-invitation
-                  {:role (name role) :updated-at (dt/now)}
-                  {:team-id team-id :email-to (profile/clean-email email)})
+    (db/update! conn :team-invitation
+                {:role (name role) :updated-at (dt/now)}
+                {:team-id team-id :email-to (profile/clean-email email)})
 
-      nil)))
+    nil))
 
 ;; --- Mutation: Delete invitation
 
@@ -432,20 +432,20 @@
 
 (sv/defmethod ::delete-team-invitation
   {::doc/added "1.17"
-   ::sm/params schema:delete-team-invition}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (teams/get-permissions conn profile-id team-id)]
+   ::sm/params schema:delete-team-invition
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id team-id email] :as params}]
+  (let [perms (teams/get-permissions conn profile-id team-id)]
 
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
+    (when-not (:is-admin perms)
+      (ex/raise :type :validation
+                :code :insufficient-permissions))
 
-      (let [invitation (db/delete! conn :team-invitation
-                                   {:team-id team-id
-                                    :email-to (profile/clean-email email)}
-                                   {::db/return-keys true})]
-        (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))
+    (let [invitation (db/delete! conn :team-invitation
+                                 {:team-id team-id
+                                  :email-to (profile/clean-email email)}
+                                 {::db/return-keys true})]
+      (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}}))))
 
 
 ;; --- Mutation: Request Team Invitation

backend/src/app/rpc/commands/viewer.clj

@@ -78,7 +78,10 @@
                   :always
                   (update :data select-keys [:id :options :pages :pages-index :components]))
 
-        libs    (files/get-file-libraries conn file-id)
+        libs    (->> (files/get-file-libraries conn file-id)
+                     (mapv (fn [{:keys [id] :as lib}]
+                             (merge lib (files/get-file cfg id)))))
+
         links   (->> (db/query conn :share-link {:file-id file-id})
                      (mapv (fn [row]
                              (-> row

backend/src/app/rpc/commands/webhooks.clj

@@ -144,20 +144,20 @@
 
 (sv/defmethod ::delete-webhook
   {::doc/added "1.17"
-   ::sm/params schema:delete-webhook}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
-  (db/with-atomic [conn pool]
-    (let [whook (-> (db/get conn :webhook {:id id}) decode-row)]
-      (check-webhook-edition-permissions! conn profile-id (:team-id whook) (:profile-id whook))
-      (db/delete! conn :webhook {:id id})
-      nil)))
+   ::sm/params schema:delete-webhook
+   ::db/transaction true}
+  [{:keys [::db/conn]} {:keys [::rpc/profile-id id]}]
+  (let [whook (-> (db/get conn :webhook {:id id}) decode-row)]
+    (check-webhook-edition-permissions! conn profile-id (:team-id whook) (:profile-id whook))
+    (db/delete! conn :webhook {:id id})
+    nil))
 
 ;; --- Query: Webhooks
 
 (def sql:get-webhooks
-  "SELECT id, uri, mtype, is_active, error_code, error_count, profile_id 
-     FROM webhook 
-    WHERE team_id = ? 
+  "SELECT id, uri, mtype, is_active, error_code, error_count, profile_id
+     FROM webhook
+    WHERE team_id = ?
     ORDER BY uri")
 
 (def ^:private schema:get-webhooks

backend/src/app/setup.clj

@@ -78,19 +78,19 @@
 
 (defmethod ig/init-key ::props
   [_ {:keys [::db/pool ::key] :as cfg}]
-  (db/with-atomic [conn pool]
-    (db/xact-lock! conn 0)
-    (when-not key
-      (l/warn :hint (str "using autogenerated secret-key, it will change on each restart and will invalidate "
-                         "all sessions on each restart, it is highly recommended setting up the "
-                         "PENPOT_SECRET_KEY environment variable")))
 
-    (let [secret (or key (generate-random-key))]
-      (-> (get-all-props conn)
-          (assoc :secret-key secret)
-          (assoc :tokens-key (keys/derive secret :salt "tokens"))
-          (update :instance-id handle-instance-id conn (db/read-only? pool))))))
+  (db/tx-run! cfg (fn [{:keys [::db/conn]}]
+                    (db/xact-lock! conn 0)
+                    (when-not key
+                      (l/warn :hint (str "using autogenerated secret-key, it will change on each restart and will invalidate "
+                                         "all sessions on each restart, it is highly recommended setting up the "
+                                         "PENPOT_SECRET_KEY environment variable")))
 
+                    (let [secret (or key (generate-random-key))]
+                      (-> (get-all-props conn)
+                          (assoc :secret-key secret)
+                          (assoc :tokens-key (keys/derive secret :salt "tokens"))
+                          (update :instance-id handle-instance-id conn (db/read-only? pool)))))))
 
 ;; FIXME
 (sm/register! ::props :any)

backend/src/app/srepl/cli.clj

@@ -36,37 +36,39 @@
 (defmethod exec-command :create-profile
   [{:keys [fullname email password is-active]
     :or {is-active true}}]
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-      (let [password (cmd.profile/derive-password system password)
-            params   {:id (uuid/next)
-                      :email email
-                      :fullname fullname
-                      :is-active is-active
-                      :password password
-                      :props {}}]
-        (->> (cmd.auth/create-profile! conn params)
-             (cmd.auth/create-profile-rels! conn))))))
+  (some-> (get-current-system)
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (let [password (cmd.profile/derive-password system password)
+                   params   {:id (uuid/next)
+                             :email email
+                             :fullname fullname
+                             :is-active is-active
+                             :password password
+                             :props {}}]
+               (->> (cmd.auth/create-profile! conn params)
+                    (cmd.auth/create-profile-rels! conn)))))))
 
 (defmethod exec-command :update-profile
   [{:keys [fullname email password is-active]}]
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-      (let [params (cond-> {}
-                     (some? fullname)
-                     (assoc :fullname fullname)
+  (some-> (get-current-system)
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (let [params (cond-> {}
+                            (some? fullname)
+                            (assoc :fullname fullname)
 
-                     (some? password)
-                     (assoc :password (auth/derive-password password))
+                            (some? password)
+                            (assoc :password (auth/derive-password password))
 
-                     (some? is-active)
-                     (assoc :is-active is-active))]
-        (when (seq params)
-          (let [res (db/update! conn :profile
-                                params
-                                {:email email
-                                 :deleted-at nil})]
-            (pos? (db/get-update-count res))))))))
+                            (some? is-active)
+                            (assoc :is-active is-active))]
+               (when (seq params)
+                 (let [res (db/update! conn :profile
+                                       params
+                                       {:email email
+                                        :deleted-at nil})]
+                   (pos? (db/get-update-count res)))))))))
 
 (defmethod exec-command :delete-profile
   [{:keys [email soft]}]
@@ -75,16 +77,16 @@
               :code :invalid-arguments
               :hint "email should be provided"))
 
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-
-      (let [res (if soft
-                  (db/update! conn :profile
-                              {:deleted-at (dt/now)}
-                              {:email email :deleted-at nil})
-                  (db/delete! conn :profile
-                              {:email email}))]
-        (pos? (db/get-update-count res))))))
+  (some-> (get-current-system)
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (let [res (if soft
+                         (db/update! conn :profile
+                                     {:deleted-at (dt/now)}
+                                     {:email email :deleted-at nil})
+                         (db/delete! conn :profile
+                                     {:email email}))]
+               (pos? (db/get-update-count res)))))))
 
 (defmethod exec-command :search-profile
   [{:keys [email]}]
@@ -93,12 +95,12 @@
               :code :invalid-arguments
               :hint "email should be provided"))
 
-  (when-let [system (get-current-system)]
-    (db/with-atomic [conn (:app.db/pool system)]
-
-      (let [sql (str "select email, fullname, created_at, deleted_at from profile "
-                     " where email similar to ? order by created_at desc limit 100")]
-        (db/exec! conn [sql email])))))
+  (some-> (get-current-system)
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (let [sql (str "select email, fullname, created_at, deleted_at from profile "
+                            " where email similar to ? order by created_at desc limit 100")]
+               (db/exec! conn [sql email]))))))
 
 (defmethod exec-command :derive-password
   [{:keys [password]}]

backend/src/app/srepl/helpers.clj

@@ -10,6 +10,7 @@
   (:require
    [app.binfile.common :as bfc]
    [app.common.data :as d]
+   [app.common.files.migrations :as fmg]
    [app.common.files.validate :as cfv]
    [app.db :as db]
    [app.features.components-v2 :as feat.comp-v2]
@@ -142,7 +143,9 @@
                   (update-fn file opts)))]
 
     (when (and (some? file')
-               (not (identical? file file')))
+               (or (fmg/migrated? file)
+                   (not (identical? file file'))))
+
       (when validate?
         (cfv/validate-file-schema! file'))
 

backend/src/app/srepl/main.clj

@@ -101,38 +101,46 @@
   "Mark the profile blocked and removes all the http sessiones
   associated with the profile-id."
   [email]
-  (db/with-atomic [conn (:app.db/pool main/system)]
-    (when-let [profile (db/get* conn :profile
-                                {:email (str/lower email)}
-                                {:columns [:id :email]})]
-      (when-not (:is-blocked profile)
-        (db/update! conn :profile {:is-active true} {:id (:id profile)})
-        :activated))))
+  (some-> main/system
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (when-let [profile (db/get* conn :profile
+                                         {:email (str/lower email)}
+                                         {:columns [:id :email]})]
+               (when-not (:is-blocked profile)
+                 (db/update! conn :profile {:is-active true} {:id (:id profile)})
+                 :activated))))))
 
 (defn mark-profile-as-blocked!
   "Mark the profile blocked and removes all the http sessiones
   associated with the profile-id."
   [email]
-  (db/with-atomic [conn (:app.db/pool main/system)]
-    (when-let [profile (db/get* conn :profile
-                                {:email (str/lower email)}
-                                {:columns [:id :email]})]
-      (when-not (:is-blocked profile)
-        (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
-        (db/delete! conn :http-session {:profile-id (:id profile)})
-        :blocked))))
+  (some-> main/system
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (when-let [profile (db/get* conn :profile
+                                         {:email (str/lower email)}
+                                         {:columns [:id :email]})]
+               (when-not (:is-blocked profile)
+                 (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
+                 (db/delete! conn :http-session {:profile-id (:id profile)})
+                 :blocked))))))
 
 (defn reset-password!
   "Reset a password to a specific one for a concrete user or all users
   if email is `:all` keyword."
   [& {:keys [email password] :or {password "123123"} :as params}]
-  (us/verify! (contains? params :email) "`email` parameter is mandatory")
-  (db/with-atomic [conn (:app.db/pool main/system)]
-    (let [password (derive-password password)]
-      (if (= email :all)
-        (db/exec! conn ["update profile set password=?" password])
-        (let [email (str/lower email)]
-          (db/exec! conn ["update profile set password=? where email=?" password email]))))))
+  (when-not email
+    (throw (IllegalArgumentException. "email is mandatory")))
+
+  (some-> main/system
+          (db/tx-run!
+           (fn [{:keys [::db/conn] :as system}]
+             (let [password (derive-password password)]
+               (if (= email :all)
+                 (db/exec! conn ["update profile set password=?" password])
+                 (let [email (str/lower email)]
+                   (db/exec! conn ["update profile set password=? where email=?" password email]))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; FEATURES
@@ -154,8 +162,8 @@
   (enable-pointer-map-feature-on-file! file-id opts))
 
 (defn enable-team-feature!
-  [team-id feature]
-  (when-not (contains? cfeat/supported-features feature)
+  [team-id feature & {:keys [skip-check] :or {skip-check false}}]
+  (when (and (not skip-check) (not (contains? cfeat/supported-features feature)))
     (ex/raise :type :assertion
               :code :feature-not-supported
               :hint (str "feature '" feature "' not supported")))
@@ -173,9 +181,8 @@
                       :enabled))))))
 
 (defn disable-team-feature!
-  [team-id feature]
-
-  (when-not (contains? cfeat/supported-features feature)
+  [team-id feature & {:keys [skip-check] :or {skip-check false}}]
+  (when (and (not skip-check) (not (contains? cfeat/supported-features feature)))
     (ex/raise :type :assertion
               :code :feature-not-supported
               :hint (str "feature '" feature "' not supported")))
@@ -202,100 +209,116 @@
   This method allows send flash notifications to specified target destinations.
   The message can be a free text or a preconfigured one.
 
-  The destination can be: all, profile-id, team-id, or a coll of them."
-  [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
-                                        :or {code :generic level :info}
-                                        :as params}]
+  The destination can be: all, profile-id, team-id, or a coll of them.
+  It also can be:
+
+  {:email \"some@example.com\"}
+  [[:email \"some@example.com\"], ...]
+
+  Command examples:
+
+  (notify! :dest :all :code :maintenance)
+  (notify! :dest :all :code :upgrade-version)
+  "
+  [& {:keys [dest code message level]
+      :or {code :generic level :info}
+      :as params}]
 
   (when-not (contains? #{:success :error :info :warning} level)
     (ex/raise :type :assertion
               :code :incorrect-level
               :hint (str "level '" level "' not supported")))
 
-  (letfn [(send [dest]
-            (l/inf :hint "sending notification" :dest (str dest))
-            (let [message {:type :notification
-                           :code code
-                           :level level
-                           :version (:full cf/version)
-                           :subs-id dest
-                           :message message}
-                  message (->> (dissoc params :dest :code :message :level)
-                               (merge message))]
-              (mbus/pub! msgbus
-                         :topic (str dest)
-                         :message message)))
+  (let [{:keys [::mbus/msgbus ::db/pool]} main/system
 
-          (resolve-profile [email]
-            (some-> (db/get* pool :profile {:email (str/lower email)} {:columns [:id]}) :id vector))
+        send
+        (fn [dest]
+          (l/inf :hint "sending notification" :dest (str dest))
+          (let [message {:type :notification
+                         :code code
+                         :level level
+                         :version (:full cf/version)
+                         :subs-id dest
+                         :message message}
+                message (->> (dissoc params :dest :code :message :level)
+                             (merge message))]
+            (mbus/pub! msgbus
+                       :topic dest
+                       :message message)))
 
-          (resolve-team [team-id]
-            (->> (db/query pool :team-profile-rel
-                           {:team-id team-id}
-                           {:columns [:profile-id]})
-                 (map :profile-id)))
+        resolve-profile
+        (fn [email]
+          (some-> (db/get* pool :profile {:email (str/lower email)} {:columns [:id]}) :id vector))
 
-          (resolve-dest [dest]
-            (cond
-              (= :all dest)
-              [uuid/zero]
+        resolve-team
+        (fn [team-id]
+          (->> (db/query pool :team-profile-rel
+                         {:team-id team-id}
+                         {:columns [:profile-id]})
+               (map :profile-id)))
 
-              (uuid? dest)
-              [dest]
+        resolve-dest
+        (fn resolve-dest [dest]
+          (cond
+            (= :all dest)
+            [uuid/zero]
 
-              (string? dest)
-              (some-> dest h/parse-uuid resolve-dest)
+            (uuid? dest)
+            [dest]
 
-              (nil? dest)
-              (resolve-dest uuid/zero)
+            (string? dest)
+            (some-> dest h/parse-uuid resolve-dest)
 
-              (map? dest)
-              (sequence (comp
-                         (map vec)
-                         (mapcat resolve-dest))
-                        dest)
+            (nil? dest)
+            [uuid/zero]
 
-              (and (vector? dest)
-                   (every? vector? dest))
-              (sequence (comp
-                         (map vec)
-                         (mapcat resolve-dest))
-                        dest)
+            (map? dest)
+            (sequence (comp
+                       (map vec)
+                       (mapcat resolve-dest))
+                      dest)
 
-              (and (vector? dest)
-                   (keyword? (first dest)))
-              (let [[op param] dest]
+            (and (vector? dest)
+                 (every? vector? dest))
+            (sequence (comp
+                       (map vec)
+                       (mapcat resolve-dest))
+                      dest)
+
+            (and (vector? dest)
+                 (keyword? (first dest)))
+            (let [[op param] dest]
+              (cond
+                (= op :email)
                 (cond
-                  (= op :email)
-                  (cond
-                    (and (coll? param)
-                         (every? string? param))
-                    (sequence (comp
-                               (keep resolve-profile)
-                               (mapcat identity))
-                              param)
+                  (and (coll? param)
+                       (every? string? param))
+                  (sequence (comp
+                             (keep resolve-profile)
+                             (mapcat identity))
+                            param)
 
-                    (string? param)
-                    (resolve-profile param))
+                  (string? param)
+                  (resolve-profile param))
 
-                  (= op :team-id)
-                  (cond
-                    (coll? param)
-                    (sequence (comp
-                               (mapcat resolve-team)
-                               (keep h/parse-uuid))
-                              param)
+                (= op :team-id)
+                (cond
+                  (coll? param)
+                  (sequence (comp
+                             (mapcat resolve-team)
+                             (keep h/parse-uuid))
+                            param)
 
-                    (uuid? param)
-                    (resolve-team param)
+                  (uuid? param)
+                  (resolve-team param)
 
-                    (string? param)
-                    (some-> param h/parse-uuid resolve-team))
+                  (string? param)
+                  (some-> param h/parse-uuid resolve-team))
 
-                  (= op :profile-id)
-                  (if (coll? param)
-                    (sequence (keep h/parse-uuid) param)
-                    (resolve-dest param))))))]
+                (= op :profile-id)
+                (if (coll? param)
+                  (sequence (keep h/parse-uuid) param)
+                  (resolve-dest param))))))]
 
     (->> (resolve-dest dest)
          (filter some?)
@@ -314,14 +337,23 @@
     (db/tx-run! main/system fsnap/create-file-snapshot! {:file-id file-id :label label})))
 
 (defn restore-file-snapshot!
-  [file-id label]
-  (let [file-id (h/parse-uuid file-id)]
+  [file-id & {:keys [label id]}]
+  (let [file-id     (h/parse-uuid file-id)
+        snapshot-id (some-> id h/parse-uuid)]
     (db/tx-run! main/system
                 (fn [{:keys [::db/conn] :as system}]
-                  (when-let [snapshot (->> (h/search-file-snapshots conn #{file-id} label)
-                                           (map :id)
-                                           (first))]
-                    (fsnap/restore-file-snapshot! system file-id (:id snapshot)))))))
+                  (cond
+                    (uuid? snapshot-id)
+                    (fsnap/restore-file-snapshot! system file-id snapshot-id)
+
+                    (string? label)
+                    (->> (h/search-file-snapshots conn #{file-id} label)
+                         (map :id)
+                         (first)
+                         (fsnap/restore-file-snapshot! system file-id))
+
+                    :else
+                    (throw (ex-info "snapshot id or label should be provided" {})))))))
 
 (defn list-file-snapshots!
   [file-id & {:as _}]

backend/src/app/tasks/tasks_gc.clj

@@ -26,18 +26,14 @@
   {k (assoc v ::min-age (cf/get-deletion-delay))})
 
 (defmethod ig/init-key ::handler
-  [_ {:keys [::db/pool ::min-age] :as cfg}]
+  [_ {:keys [::min-age] :as cfg}]
   (fn [{:keys [props] :as task}]
     (let [min-age (or (:min-age props) min-age)]
-      (db/with-atomic [conn pool]
-        (let [interval (db/interval min-age)
-              result   (db/exec-one! conn [sql:delete-completed-tasks interval])
-              result   (db/get-update-count result)]
-
-          (l/debug :hint "task finished" :total result)
-
-          (when (:rollback? props)
-            (db/rollback! conn))
-
-          result)))))
-
+      (-> cfg
+          (assoc ::db/rollback (:rollback? props))
+          (db/tx-run! (fn [{:keys [::db/conn]}]
+                        (let [interval (db/interval min-age)
+                              result   (db/exec-one! conn [sql:delete-completed-tasks interval])
+                              result   (db/get-update-count result)]
+                          (l/debug :hint "task finished" :total result)
+                          result)))))))

backend/src/app/worker/dispatcher.clj

@@ -71,11 +71,12 @@
 
           (run-batch! [rconn]
             (try
-              (db/with-atomic [conn pool]
-                (if-let [tasks (get-tasks conn)]
-                  (->> (group-by :queue tasks)
-                       (run! (partial push-tasks! conn rconn)))
-                  (px/sleep (::wait-duration cfg))))
+              (db/tx-run! cfg (fn [{:keys [::db/conn]}]
+                                (if-let [tasks (get-tasks conn)]
+                                  (->> (group-by :queue tasks)
+                                       (run! (partial push-tasks! conn rconn)))
+                                  ;; FIXME: this sleep should be outside the transaction
+                                  (px/sleep (::wait-duration cfg)))))
               (catch InterruptedException cause
                 (throw cause))
               (catch Exception cause

backend/src/app/worker/runner.clj

@@ -24,6 +24,33 @@
 
 (set! *warn-on-reflection* true)
 
+(def schema:task
+  [:map {:title "Task"}
+   [:id ::sm/uuid]
+   [:queue :string]
+   [:name :string]
+   [:created-at ::sm/inst]
+   [:modified-at ::sm/inst]
+   [:scheduled-at {:optional true} ::sm/inst]
+   [:completed-at {:optional true} ::sm/inst]
+   [:error {:optional true} :string]
+   [:max-retries :int]
+   [:retry-num :int]
+   [:priority :int]
+   [:status [:enum "scheduled" "completed" "new" "retry" "failed"]]
+   [:label {:optional true} :string]
+   [:props :map]])
+
+(def schema:result
+  [:map {:title "TaskResult"}
+   [:status [:enum "retry" "failed" "completed"]]
+   [:error {:optional true} [:fn ex/exception?]]
+   [:inc-by {:optional true} :int]
+   [:delay {:optional true} :int]])
+
+(def valid-task-result?
+  (sm/validator schema:result))
+
 (defn- decode-task-row
   [{:keys [props] :as row}]
   (cond-> row
@@ -51,10 +78,11 @@
            :retry (:retry-num task))
     (let [tpoint  (dt/tpoint)
           task-fn (wrk/get-task registry (:name task))
-          result  (if task-fn
-                    (task-fn task)
-                    {:status :completed :task task})
-          elapsed (dt/format-duration (tpoint))]
+          result  (when task-fn (task-fn task))
+          elapsed (dt/format-duration (tpoint))
+          result  (if (valid-task-result? result)
+                    result
+                    {:status "completed"})]
 
       (when-not task-fn
         (l/wrn :hint "no task handler found" :name (:name task)))
@@ -76,7 +104,7 @@
         (if (and (< (:retry-num task)
                     (:max-retries task))
                  (= ::retry (:type edata)))
-          (cond-> {:status :retry :task task :error cause}
+          (cond-> {:status "retry" :error cause}
             (dt/duration? (:delay edata))
             (assoc :delay (:delay edata))
 
@@ -87,8 +115,8 @@
                    ::l/context (get-error-context cause task)
                    :cause cause)
             (if (>= (:retry-num task) (:max-retries task))
-              {:status :failed :task task :error cause}
-              {:status :retry :task task :error cause})))))))
+              {:status "failed" :error cause}
+              {:status "retry" :error cause})))))))
 
 (defn- run-task!
   [{:keys [::id ::timeout] :as cfg} task-id]
@@ -116,12 +144,17 @@
              :task-id task-id)
 
       :else
-      (run-task cfg task))))
+      (let [result (run-task cfg task)]
+        (with-meta result
+          {::task task})))))
 
 (defn- run-worker-loop!
   [{:keys [::db/pool ::rds/rconn ::timeout ::queue] :as cfg}]
-  (letfn [(handle-task-retry [{:keys [task error inc-by delay] :or {inc-by 1 delay 1000}}]
-            (let [explain (ex-message error)
+  (letfn [(handle-task-retry [{:keys [error inc-by delay] :or {inc-by 1 delay 1000} :as result}]
+            (let [explain (if (ex/exception? error)
+                            (ex-message error)
+                            (str error))
+                  task    (-> result meta ::task)
                   nretry  (+ (:retry-num task) inc-by)
                   now     (dt/now)
                   delay   (->> (iterate #(* % 2) delay) (take nretry) (last))]
@@ -134,8 +167,9 @@
                           {:id (:id task)})
               nil))
 
-          (handle-task-failure [{:keys [task error]}]
-            (let [explain (ex-message error)]
+          (handle-task-failure [{:keys [error] :as result}]
+            (let [task    (-> result meta ::task)
+                  explain (ex-message error)]
               (db/update! pool :task
                           {:error explain
                            :modified-at (dt/now)
@@ -143,8 +177,9 @@
                           {:id (:id task)})
               nil))
 
-          (handle-task-completion [{:keys [task]}]
-            (let [now (dt/now)]
+          (handle-task-completion [result]
+            (let [task (-> result meta ::task)
+                  now  (dt/now)]
               (db/update! pool :task
                           {:completed-at now
                            :modified-at now
@@ -168,10 +203,11 @@
           (process-result [{:keys [status] :as result}]
             (ex/try!
              (case status
-               :retry (handle-task-retry result)
-               :failed (handle-task-failure result)
-               :completed (handle-task-completion result)
-               nil)))
+               "retry"     (handle-task-retry result)
+               "failed"    (handle-task-failure result)
+               "completed" (handle-task-completion result)
+               (throw (IllegalArgumentException.
+                       (str "invalid status received: " status))))))
 
           (run-task-loop [task-id]
             (loop [result (run-task! cfg task-id)]

backend/test/backend_tests/helpers.clj

@@ -138,14 +138,13 @@
                  "  FROM information_schema.tables "
                  " WHERE table_schema = 'public' "
                  "   AND table_name != 'migrations';")]
-    (db/with-atomic [conn *pool*]
-      (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
-      (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
-      (let [result (->> (db/exec! conn [sql])
-                        (map :table-name))]
-        (doseq [table result]
-          (db/exec! conn [(str "delete from " table ";")]))))
-
+    (db/transact! *pool* (fn [conn]
+                           (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+                           (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
+                           (let [result (->> (db/exec! conn [sql])
+                                             (map :table-name))]
+                             (doseq [table result]
+                               (db/exec! conn [(str "delete from " table ";")])))))
     (next)))
 
 (defn clean-storage

backend/test/backend_tests/http_middleware_access_token_test.clj

@@ -20,45 +20,33 @@
 (t/use-fixtures :each th/database-reset)
 
 (t/deftest soft-auth-middleware
-  (db/with-atomic [conn (::db/pool th/*system*)]
-    (let [profile (th/create-profile* 1)
-          system  (-> th/*system*
-                      (assoc ::db/conn conn)
-                      (assoc ::main/props (:app.setup/props th/*system*)))
+  (let [profile (th/create-profile* 1)
+        token   (db/tx-run! th/*system* app.rpc.commands.access-token/create-access-token (:id profile) "test" nil)
 
-          token   (app.rpc.commands.access-token/create-access-token
-                   system (:id profile) "test" nil)
+        request (volatile! nil)
+        handler (#'app.http.access-token/wrap-soft-auth
+                 (fn [req] (vreset! request req))
+                 th/*system*)]
 
-          request (volatile! nil)
-          handler (#'app.http.access-token/wrap-soft-auth
-                   (fn [req] (vreset! request req))
-                   system)]
+    (with-mocks [m1 {:target 'app.http.access-token/get-token
+                     :return nil}]
+      (handler {})
+      (t/is (= {} @request)))
 
-      (with-mocks [m1 {:target 'app.http.access-token/get-token
-                       :return nil}]
-        (handler {})
-        (t/is (= {} @request)))
+    (with-mocks [m1 {:target 'app.http.access-token/get-token
+                     :return (:token token)}]
+      (handler {})
 
-      (with-mocks [m1 {:target 'app.http.access-token/get-token
-                       :return (:token token)}]
-        (handler {})
-
-        (let [token-id (get @request :app.http.access-token/id)]
-          (t/is (= token-id (:id token))))))))
+      (let [token-id (get @request :app.http.access-token/id)]
+        (t/is (= token-id (:id token)))))))
 
 (t/deftest authz-middleware
   (let [profile (th/create-profile* 1)
-        system  (assoc th/*system* ::main/props (:app.setup/props th/*system*))
-
-        token   (db/with-atomic [conn (::db/pool th/*system*)]
-                  (let [system (assoc system ::db/conn conn)]
-                    (app.rpc.commands.access-token/create-access-token
-                     system (:id profile) "test" nil)))
-
+        token   (db/tx-run! th/*system* app.rpc.commands.access-token/create-access-token (:id profile) "test" nil)
         request (volatile! {})
         handler (#'app.http.access-token/wrap-authz
                  (fn [req] (vreset! request req))
-                 system)]
+                 th/*system*)]
 
     (handler nil)
     (t/is (nil? @request))

backend/test/backend_tests/rpc_media_test.clj

@@ -48,7 +48,7 @@
         (t/is (sto/object? mobj1))
         (t/is (sto/object? mobj2))
         (t/is (= 122785 (:size mobj1)))
-        (t/is (= 3302 (:size mobj2)))))))
+        (t/is (= 3299 (:size mobj2)))))))
 
 (t/deftest media-object-upload
   (let [prof   (th/create-profile* 1)
@@ -85,7 +85,7 @@
         (t/is (sto/object? mobj1))
         (t/is (sto/object? mobj2))
         (t/is (= 312043 (:size mobj1)))
-        (t/is (= 3887   (:size mobj2)))))))
+        (t/is (= 3901   (:size mobj2)))))))
 
 
 (t/deftest media-object-upload-idempotency
@@ -163,7 +163,7 @@
         (t/is (sto/object? mobj1))
         (t/is (sto/object? mobj2))
         (t/is (= 122785 (:size mobj1)))
-        (t/is (= 3302 (:size mobj2)))))))
+        (t/is (= 3299 (:size mobj2)))))))
 
 (t/deftest media-object-upload-command
   (let [prof   (th/create-profile* 1)
@@ -200,7 +200,7 @@
         (t/is (sto/object? mobj1))
         (t/is (sto/object? mobj2))
         (t/is (= 312043 (:size mobj1)))
-        (t/is (= 3887   (:size mobj2)))))))
+        (t/is (= 3901   (:size mobj2)))))))
 
 
 (t/deftest media-object-upload-idempotency-command

common/package.json

@@ -4,7 +4,7 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.6.0+sha512.5383cc12567a95f1d668fbe762dfe0075c595b4bfff433be478dbbe24e05251a8e8c3eb992a986667c1d53b6c3a9c85b8398c35a960587fbd9fa3a0915406728",
+  "packageManager": "yarn@4.8.1+sha512.bc946f2a022d7a1a38adfc15b36a66a3807a67629789496c3714dd1703d2e6c6b1c69ff9ec3b43141ac7a1dd853b7685638eb0074300386a59c18df351ef8ff6",
   "type": "module",
   "repository": {
     "type": "git",

common/src/app/common/colors.cljc

@@ -342,13 +342,20 @@
   (-> (hex->hsl data)
       (conj opacity)))
 
-#?(:cljs
-   (defn format-hsla
-     [[h s l a]]
-     (let [precision 2
-           rounded-s (* 100 (parse-double (d/format-precision s precision)))
-           rounded-l (* 100 (parse-double (d/format-precision l precision)))]
-       (str/concat "" h ", " rounded-s "%, " rounded-l "%, " a))))
+(defn format-hsla
+  [[h s l a]]
+  (let [precision 2
+        rounded-h (int h)
+        rounded-s (d/format-number (* 100 s) precision)
+        rounded-l (d/format-number (* 100 l) precision)
+        rounded-a (d/format-number a precision)]
+    (str/concat "" rounded-h ", " rounded-s "%, " rounded-l "%, " rounded-a)))
+
+(defn format-rgba
+  [[r g b a]]
+  (let [precision 2
+        rounded-a (d/format-number a precision)]
+    (str/ffmt "%, %, %, %" r g b rounded-a)))
 
 (defn- hue->rgb
   "Helper for hsl->rgb"

common/src/app/common/data.cljc

@@ -82,15 +82,22 @@
   "Assoc a k v pair, in the order position just before the other key."
   [o ks k v before-k]
   (let [f (fn [o']
-            (cond-> (reduce
-                     (fn [acc [k' v']]
-                       (cond
-                         (and before-k (= k' before-k)) (assoc acc k v k' v')
-                         (= k k') acc
-                         :else (assoc acc k' v')))
-                     (ordered-map)
-                     o')
-              (not before-k) (assoc k v)))]
+            (let [found  (volatile! false)
+                  result (reduce
+                          (fn [acc [k' v']]
+                            (cond
+                              (and before-k (= k' before-k))
+                              (do
+                                (vreset! found true)
+                                (assoc acc k v k' v'))
+
+                              (= k k') acc
+                              :else (assoc acc k' v')))
+                          (ordered-map)
+                          o')]
+              (if (or (not before-k) (not @found))
+                (assoc result k v)
+                result)))]
     (if (seq ks)
       (oupdate-in o ks f)
       (f o))))
@@ -1007,27 +1014,35 @@
 (def ^:const trail-zeros-regex-1 #"\.0+$")
 (def ^:const trail-zeros-regex-2 #"(\.\d*[^0])0+$")
 
-#?(:cljs
-   (defn format-precision
-     "Creates a number with predetermined precision and then removes the trailing 0.
+(defn format-precision
+  "Creates a number with predetermined precision and then removes the trailing 0.
   Examples:
     12.0123, 0 => 12
     12.0123, 1 => 12
     12.0123, 2 => 12.01"
-     [num precision]
+  [num precision]
 
-     (if (number? num)
-       (try
-         (let [num-str (mth/to-fixed num precision)
+  (if (number? num)
+    (try
+      (let [num-str (mth/to-fixed num precision)
                ;; Remove all trailing zeros after the comma 100.00000
-               num-str (str/replace num-str trail-zeros-regex-1 "")]
+            num-str (str/replace num-str trail-zeros-regex-1 "")]
            ;; Remove trailing zeros after a decimal number: 0.001|00|
-           (if-let [m (re-find trail-zeros-regex-2 num-str)]
-             (str/replace num-str (first m) (second m))
-             num-str))
-         (catch :default _
-           (str num)))
-       (str num))))
+        (if-let [m (re-find trail-zeros-regex-2 num-str)]
+          (str/replace num-str (first m) (second m))
+          num-str))
+      (catch #?(:clj Throwable :cljs :default) _
+        (str num)))
+    (str num)))
+
+(defn format-number
+  ([value]
+   (format-number value nil))
+  ([value {:keys [precision] :or {precision 2}}]
+   (let [value (if (string? value) (parse-double value) value)]
+     (when (num? value)
+       (let [value (format-precision value precision)]
+         (str value))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Util protocols

common/src/app/common/data/undo_stack.cljc

@@ -47,7 +47,7 @@
 
 (defn undo
   [stack]
-  (update stack :index dec))
+  (update stack :index #(max 0 (dec %))))
 
 (defn redo
   [{index :index items :items :as stack}]

common/src/app/common/features.cljc

@@ -52,7 +52,8 @@
     "plugins/runtime"
     "design-tokens/v1"
     "text-editor/v2"
-    "render-wasm/v1"})
+    "render-wasm/v1"
+    "variants/v1"})
 
 ;; A set of features enabled by default
 (def default-features
@@ -60,7 +61,8 @@
     "styles/v2"
     "layout/grid"
     "components/v2"
-    "plugins/runtime"})
+    "plugins/runtime"
+    "design-tokens/v1"})
 
 ;; A set of features which only affects on frontend and can be enabled
 ;; and disabled freely by the user any time. This features does not
@@ -83,12 +85,11 @@
 ;; be applied (per example backend can operate in both modes with or
 ;; without migration applied)
 (def no-migration-features
-  (-> #{"fdata/objects-map"
-        "fdata/pointer-map"
-        "layout/grid"
+  (-> #{"layout/grid"
         "fdata/shape-data-type"
         "design-tokens/v1"}
-      (into frontend-only-features)))
+      (into frontend-only-features)
+      (into backend-only-features)))
 
 (sm/register!
  ^{::sm/type ::features}
@@ -111,6 +112,7 @@
     :feature-design-tokens "design-tokens/v1"
     :feature-text-editor-v2 "text-editor/v2"
     :feature-render-wasm "render-wasm/v1"
+    :feature-variants "variants/v1"
     nil))
 
 (defn migrate-legacy-features
@@ -155,7 +157,6 @@
         team-features    (into #{} xf-remove-ephimeral (:features team))]
     (-> enabled-features
         (set/intersection no-migration-features)
-        (set/difference frontend-only-features)
         (set/union team-features))))
 
 (defn check-client-features!
@@ -164,6 +165,8 @@
   frontend client"
   [enabled-features client-features]
   (when (set? client-features)
+    ;; Check if client declares support for features enabled on
+    ;; backend side
     (let [not-supported (-> enabled-features
                             (set/difference client-features)
                             (set/difference frontend-only-features)
@@ -173,14 +176,6 @@
                   :code :feature-not-supported
                   :feature (first not-supported)
                   :hint (str/ffmt "client declares no support for '%' features"
-                                  (str/join "," not-supported)))))
-
-    (let [not-supported (set/difference client-features supported-features)]
-      (when (seq not-supported)
-        (ex/raise :type :restriction
-                  :code :feature-not-supported
-                  :feature (first not-supported)
-                  :hint (str/ffmt "backend does not support '%' features requested by client"
                                   (str/join "," not-supported))))))
 
   enabled-features)
@@ -191,57 +186,49 @@
   supported by the current backend"
   [enabled-features]
   (let [not-supported (set/difference enabled-features supported-features)]
-    (when (seq not-supported)
+    (when-let [not-supported (first not-supported)]
       (ex/raise :type :restriction
                 :code :feature-not-supported
-                :feature (first not-supported)
-                :hint (str/ffmt "features '%' not supported"
-                                (str/join "," not-supported)))))
-  enabled-features)
+                :feature not-supported
+                :hint (str/ffmt "feature '%' not supported on this backend" not-supported)))
+    enabled-features))
 
 (defn check-file-features!
   "Function used for check feature compability between currently
   enabled features set on backend with the provided featured set by
   the penpot file"
-  ([enabled-features file-features]
-   (check-file-features! enabled-features file-features #{}))
-  ([enabled-features file-features client-features]
-   (let [file-features   (into #{} xf-remove-ephimeral file-features)
-         ;; We should ignore all features that does not match with the
-         ;; `no-migration-features` set because we can't enable them
-         ;; as-is, because they probably need migrations
-         client-features (set/intersection client-features no-migration-features)]
-     (let [not-supported (-> enabled-features
-                             (set/union client-features)
-                             (set/difference file-features)
-                             ;; NOTE: we don't want to raise a feature-mismatch
-                             ;; exception for features which don't require an
-                             ;; explicit file migration process or has no real
-                             ;; effect on file data structure
-                             (set/difference no-migration-features))]
-       (when (seq not-supported)
-         (ex/raise :type :restriction
-                   :code :file-feature-mismatch
-                   :feature (first not-supported)
-                   :hint (str/ffmt "enabled features '%' not present in file (missing migration)"
-                                   (str/join "," not-supported)))))
+  [enabled-features file-features]
+  (let [file-features (into #{} xf-remove-ephimeral file-features)
+        not-supported (-> enabled-features
+                          (set/difference file-features)
+                          ;; NOTE: we don't want to raise a feature-mismatch
+                          ;; exception for features which don't require an
+                          ;; explicit file migration process or has no real
+                          ;; effect on file data structure
+                          (set/difference no-migration-features))]
 
-     (check-supported-features! file-features)
+    (when-let [not-supported (first not-supported)]
+      (ex/raise :type :restriction
+                :code :file-feature-mismatch
+                :feature not-supported
+                :hint (str/ffmt "enabled feature '%' not present in file (missing migration)"
+                                not-supported)))
 
-     (let [not-supported (-> file-features
-                             (set/difference enabled-features)
-                             (set/difference client-features)
-                             (set/difference backend-only-features)
-                             (set/difference frontend-only-features))]
+    (check-supported-features! file-features)
 
-       (when (seq not-supported)
-         (ex/raise :type :restriction
-                   :code :file-feature-mismatch
-                   :feature (first not-supported)
-                   :hint (str/ffmt "file features '%' not enabled"
-                                   (str/join "," not-supported))))))
+    (let [not-supported (-> file-features
+                            (set/difference enabled-features)
+                            (set/difference backend-only-features)
+                            (set/difference frontend-only-features))]
 
-   enabled-features))
+      ;; Check if file has a feature but that feature is not enabled
+      (when-let [not-supported (first not-supported)]
+        (ex/raise :type :restriction
+                  :code :file-feature-mismatch
+                  :feature not-supported
+                  :hint (str/ffmt "file feature '%' not enabled" not-supported))))
+
+    enabled-features))
 
 (defn check-teams-compatibility!
   [{source-features :features} {destination-features :features}]

common/src/app/common/files/changes.cljc

@@ -371,111 +371,58 @@
       [:type [:= :del-typography]]
       [:id ::sm/uuid]]]
 
-    [:add-temporary-token-theme
-     [:map {:title "AddTemporaryTokenThemeChange"}
-      [:type [:= :add-temporary-token-theme]]
-      [:token-theme ::ctot/token-theme]]]
-
     [:update-active-token-themes
      [:map {:title "UpdateActiveTokenThemes"}
       [:type [:= :update-active-token-themes]]
       [:theme-ids [:set :string]]]]
 
-    [:delete-temporary-token-theme
-     [:map {:title "DeleteTemporaryTokenThemeChange"}
-      [:type [:= :delete-temporary-token-theme]]
-      [:id ::sm/uuid]
-      [:name :string]]]
-
-    [:add-token-theme
-     [:map {:title "AddTokenThemeChange"}
-      [:type [:= :add-token-theme]]
-      [:token-theme ::ctot/token-theme]]]
-
-    [:mod-token-theme
-     [:map {:title "ModTokenThemeChange"}
-      [:type [:= :mod-token-theme]]
-      [:group :string]
-      [:name :string]
-      [:token-theme ::ctot/token-theme]]]
-
-    [:del-token-theme
-     [:map {:title "DelTokenThemeChange"}
-      [:type [:= :del-token-theme]]
-      [:group :string]
-      [:name :string]]]
-
-    [:add-token-set
-     [:map {:title "AddTokenSetChange"}
-      [:type [:= :add-token-set]]
-      [:token-set ::ctot/token-set]]]
-
-    [:add-token-sets
-     [:map {:title "AddTokenSetsChange"}
-      [:type [:= :add-token-sets]]
-      [:token-sets [:sequential ::ctot/token-set]]]]
-
     [:rename-token-set-group
      [:map {:title "RenameTokenSetGroup"}
       [:type [:= :rename-token-set-group]]
       [:set-group-path [:vector :string]]
       [:set-group-fname :string]]]
 
-    [:mod-token-set
-     [:map {:title "ModTokenSetChange"}
-      [:type [:= :mod-token-set]]
-      [:name :string]
-      [:token-set ::ctot/token-set]]]
-
-    [:move-token-set-before
-     [:map {:title "MoveTokenSetBefore"}
-      [:type [:= :move-token-set-before]]
+    [:move-token-set
+     [:map {:title "MoveTokenSet"}
+      [:type [:= :move-token-set]]
       [:from-path [:vector :string]]
       [:to-path [:vector :string]]
       [:before-path [:maybe [:vector :string]]]
-      [:before-group? [:maybe :boolean]]]]
+      [:before-group [:maybe :boolean]]]]
 
-    [:move-token-set-group-before
-     [:map {:title "MoveTokenSetGroupBefore"}
-      [:type [:= :move-token-set-group-before]]
+    [:move-token-set-group
+     [:map {:title "MoveTokenSetGroup"}
+      [:type [:= :move-token-set-group]]
       [:from-path [:vector :string]]
       [:to-path [:vector :string]]
       [:before-path [:maybe [:vector :string]]]
-      [:before-group? [:maybe :boolean]]]]
+      [:before-group [:maybe :boolean]]]]
 
-    [:del-token-set
-     [:map {:title "DelTokenSetChange"}
-      [:type [:= :del-token-set]]
-      [:name :string]]]
-
-    [:del-token-set-path
-     [:map {:title "DelTokenSetPathChange"}
-      [:type [:= :del-token-set-path]]
-      [:path :string]]]
+    [:set-token-theme
+     [:map {:title "SetTokenThemeChange"}
+      [:type [:= :set-token-theme]]
+      [:theme-name :string]
+      [:group :string]
+      [:theme [:maybe ::ctot/token-theme]]]]
 
     [:set-tokens-lib
      [:map {:title "SetTokensLib"}
       [:type [:= :set-tokens-lib]]
       [:tokens-lib :any]]]
 
-    [:add-token
-     [:map {:title "AddTokenChange"}
-      [:type [:= :add-token]]
+    [:set-token-set
+     [:map {:title "SetTokenSetChange"}
+      [:type [:= :set-token-set]]
       [:set-name :string]
-      [:token ::cto/token]]]
+      [:group? :boolean]
+      [:token-set [:maybe ::ctot/token-set]]]]
 
-    [:mod-token
-     [:map {:title "ModTokenChange"}
-      [:type [:= :mod-token]]
+    [:set-token
+     [:map {:title "SetTokenChange"}
+      [:type [:= :set-token]]
       [:set-name :string]
-      [:name :string]
-      [:token ::cto/token]]]
-
-    [:del-token
-     [:map {:title "DelTokenChange"}
-      [:type [:= :del-token]]
-      [:set-name :string]
-      [:name :string]]]]])
+      [:token-name :string]
+      [:token [:maybe ::cto/token]]]]]])
 
 (def schema:changes
   [:sequential {:gen/max 5 :gen/min 1} schema:change])
@@ -1040,80 +987,63 @@
   [data {:keys [tokens-lib]}]
   (assoc data :tokens-lib tokens-lib))
 
-(defmethod process-change :add-token
-  [data {:keys [set-name token]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/add-token-in-set set-name (ctob/make-token token)))))
+(defmethod process-change :set-token
+  [data {:keys [set-name token-name token]}]
+  (update data :tokens-lib
+          (fn [lib]
+            (let [lib' (ctob/ensure-tokens-lib lib)]
+              (cond
+                (not token)
+                (ctob/delete-token-from-set lib' set-name token-name)
 
-(defmethod process-change :mod-token
-  [data {:keys [set-name name token]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/update-token-in-set
-                                 set-name
-                                 name
-                                 (fn [old-token]
-                                   (ctob/make-token (merge old-token token)))))))
+                (not (ctob/get-token-in-set lib' set-name token-name))
+                (ctob/add-token-in-set lib' set-name (ctob/make-token token))
 
-(defmethod process-change :del-token
-  [data {:keys [set-name name]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/delete-token-from-set
-                                 set-name
-                                 name))))
+                :else
+                (ctob/update-token-in-set lib' set-name token-name (fn [prev-token]
+                                                                     (ctob/make-token (merge prev-token token)))))))))
 
-(defmethod process-change :add-temporary-token-theme
-  [data {:keys [token-theme]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/add-theme (ctob/make-token-theme token-theme)))))
+(defmethod process-change :set-token-set
+  [data {:keys [set-name group? token-set]}]
+  (update data :tokens-lib
+          (fn [lib]
+            (let [lib' (ctob/ensure-tokens-lib lib)]
+              (cond
+                (not token-set)
+                (if group?
+                  (ctob/delete-set-group lib' set-name)
+                  (ctob/delete-set lib' set-name))
+
+                (not (ctob/get-set lib' set-name))
+                (ctob/add-set lib' (ctob/make-token-set token-set))
+
+                :else
+                (ctob/update-set lib' set-name (fn [prev-token-set]
+                                                 (ctob/make-token-set (merge prev-token-set token-set)))))))))
+
+(defmethod process-change :set-token-theme
+  [data {:keys [group theme-name theme]}]
+  (update data :tokens-lib
+          (fn [lib]
+            (let [lib' (ctob/ensure-tokens-lib lib)]
+              (cond
+                (not theme)
+                (ctob/delete-theme lib' group theme-name)
+
+                (not (ctob/get-theme lib' group theme-name))
+                (ctob/add-theme lib' (ctob/make-token-theme theme))
+
+                :else
+                (ctob/update-theme lib'
+                                   group theme-name
+                                   (fn [prev-token-theme]
+                                     (ctob/make-token-theme (merge prev-token-theme theme)))))))))
 
 (defmethod process-change :update-active-token-themes
   [data {:keys [theme-ids]}]
   (update data :tokens-lib #(-> % (ctob/ensure-tokens-lib)
                                 (ctob/set-active-themes theme-ids))))
 
-(defmethod process-change :delete-temporary-token-theme
-  [data {:keys [group name]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/delete-theme group name))))
-
-(defmethod process-change :add-token-theme
-  [data {:keys [token-theme]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/add-theme (-> token-theme
-                                                    (ctob/make-token-theme))))))
-
-(defmethod process-change :mod-token-theme
-  [data {:keys [name group token-theme]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/update-theme group name
-                                                   (fn [prev-theme]
-                                                     (merge prev-theme token-theme))))))
-
-(defmethod process-change :del-token-theme
-  [data {:keys [group name]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/delete-theme group name))))
-
-(defmethod process-change :add-token-set
-  [data {:keys [token-set]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/add-set (ctob/make-token-set token-set)))))
-
-(defmethod process-change :add-token-sets
-  [data {:keys [token-sets]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/add-sets (map ctob/make-token-set token-sets)))))
-
 (defmethod process-change :rename-token-set-group
   [data {:keys [set-group-path set-group-fname]}]
   (update data :tokens-lib (fn [lib]
@@ -1121,37 +1051,17 @@
                                  (ctob/ensure-tokens-lib)
                                  (ctob/rename-set-group set-group-path set-group-fname)))))
 
-(defmethod process-change :mod-token-set
-  [data {:keys [name token-set]}]
-  (update data :tokens-lib (fn [lib]
-                             (-> lib
-                                 (ctob/ensure-tokens-lib)
-                                 (ctob/update-set name (fn [prev-set]
-                                                         (merge prev-set (dissoc token-set :tokens))))))))
-
-(defmethod process-change :move-token-set-before
-  [data {:keys [from-path to-path before-path before-group?] :as changes}]
+(defmethod process-change :move-token-set
+  [data {:keys [from-path to-path before-path before-group] :as changes}]
   (update data :tokens-lib #(-> %
                                 (ctob/ensure-tokens-lib)
-                                (ctob/move-set from-path to-path before-path before-group?))))
+                                (ctob/move-set from-path to-path before-path before-group))))
 
-(defmethod process-change :move-token-set-group-before
-  [data {:keys [from-path to-path before-path before-group?]}]
+(defmethod process-change :move-token-set-group
+  [data {:keys [from-path to-path before-path before-group]}]
   (update data :tokens-lib #(-> %
                                 (ctob/ensure-tokens-lib)
-                                (ctob/move-set-group from-path to-path before-path before-group?))))
-
-(defmethod process-change :del-token-set
-  [data {:keys [name]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/delete-set-path name))))
-
-(defmethod process-change :del-token-set-path
-  [data {:keys [path]}]
-  (update data :tokens-lib #(-> %
-                                (ctob/ensure-tokens-lib)
-                                (ctob/delete-set-path path))))
+                                (ctob/move-set-group from-path to-path before-path before-group))))
 
 ;; === Operations
 

common/src/app/common/files/changes_builder.cljc

@@ -155,13 +155,14 @@
     (dm/get-in data [:pages-index uuid/zero :objects])))
 
 (defn apply-changes-local
-  [changes]
+  [changes & {:keys [apply-to-library?]}]
   (dm/assert!
    "expected valid changes"
    (check-changes! changes))
 
   (if-let [file-data (::file-data (meta changes))]
-    (let [index         (::applied-changes-count (meta changes))
+    (let [library-data  (::library-data (meta changes))
+          index         (::applied-changes-count (meta changes))
           redo-changes  (:redo-changes changes)
           new-changes   (if (< index (count redo-changes))
                           (->> (subvec (:redo-changes changes) index)
@@ -169,8 +170,12 @@
                                          (assoc :page-id uuid/zero)
                                          (dissoc :component-id))))
                           [])
-          new-file-data (cfc/process-changes file-data new-changes)]
+          new-file-data (cfc/process-changes file-data new-changes)
+          new-library-data (if apply-to-library?
+                             (cfc/process-changes library-data new-changes)
+                             library-data)]
       (vary-meta changes assoc ::file-data new-file-data
+                 ::library-data new-library-data
                  ::applied-changes-count (count redo-changes)))
     changes))
 
@@ -762,13 +767,6 @@
         (update :undo-changes conj {:type :add-typography :typography prev-typography})
         (apply-changes-local))))
 
-(defn add-temporary-token-theme
-  [changes token-theme]
-  (-> changes
-      (update :redo-changes conj {:type :add-temporary-token-theme :token-theme token-theme})
-      (update :undo-changes conj {:type :delete-temporary-token-theme :id (:id token-theme) :name (:name token-theme)})
-      (apply-changes-local)))
-
 (defn update-active-token-themes
   [changes token-active-theme-ids prev-token-active-theme-ids]
   (-> changes
@@ -776,42 +774,32 @@
       (update :undo-changes conj {:type :update-active-token-themes :theme-ids prev-token-active-theme-ids})
       (apply-changes-local)))
 
-(defn add-token-theme
-  [changes token-theme]
-  (-> changes
-      (update :redo-changes conj {:type :add-token-theme :token-theme token-theme})
-      (update :undo-changes conj {:type :del-token-theme :group (:group token-theme) :name (:name token-theme)})
-      (apply-changes-local)))
-
-(defn update-token-theme
-  [changes token-theme prev-token-theme]
-  (let [name (or (:name prev-token-theme)
-                 (:name token-theme))
-        group (or (:group prev-token-theme)
-                  (:group token-theme))]
-    (-> changes
-        (update :redo-changes conj {:type :mod-token-theme :group group :name name :token-theme token-theme})
-        (update :undo-changes conj {:type :mod-token-theme :group group :name name :token-theme (or prev-token-theme token-theme)})
-        (apply-changes-local))))
-
-(defn delete-token-theme
-  [changes group name]
+(defn set-token-theme [changes group theme-name theme]
   (assert-library! changes)
   (let [library-data (::library-data (meta changes))
-        prev-token-theme (some-> (get library-data :tokens-lib)
-                                 (ctob/get-theme group name))]
+        prev-theme (some-> (get library-data :tokens-lib)
+                           (ctob/get-theme group theme-name))]
     (-> changes
-        (update :redo-changes conj {:type :del-token-theme :group group :name name})
-        (update :undo-changes conj {:type :add-token-theme :token-theme prev-token-theme})
+        (update :redo-changes conj {:type :set-token-theme
+                                    :theme-name theme-name
+                                    :group group
+                                    :theme theme})
+        (update :undo-changes conj (if prev-theme
+                                     {:type :set-token-theme
+                                      :group group
+                                      :theme-name (or
+                                                   ;; Undo of edit
+                                                   (:name theme)
+                                                   ;; Undo of delete
+                                                   theme-name)
+                                      :theme prev-theme}
+                                     ;; Undo of create
+                                     {:type :set-token-theme
+                                      :group group
+                                      :theme-name theme-name
+                                      :theme nil}))
         (apply-changes-local))))
 
-(defn add-token-set
-  [changes token-set]
-  (-> changes
-      (update :redo-changes conj {:type :add-token-set :token-set token-set})
-      (update :undo-changes conj {:type :del-token-set :name (:name token-set)})
-      (apply-changes-local)))
-
 (defn rename-token-set-group
   [changes set-group-path set-group-fname]
   (let [undo-path (ctob/replace-last-path-name set-group-path set-group-fname)
@@ -821,58 +809,34 @@
         (update :undo-changes conj {:type :rename-token-set-group :set-group-path undo-path :set-group-fname undo-fname})
         (apply-changes-local))))
 
-(defn update-token-set
-  [changes token-set prev-token-set]
-  (-> changes
-      (update :redo-changes conj {:type :mod-token-set :name (:name prev-token-set) :token-set token-set})
-      (update :undo-changes conj {:type :mod-token-set :name (:name token-set) :token-set (or prev-token-set token-set)})
-      (apply-changes-local)))
-
-(defn delete-token-set-path
-  [changes group? path]
-  (assert-library! changes)
-  (let [;; TODO Move leaking prefix to library
-        prefixed-path (if group?
-                        (ctob/set-group-path->set-group-prefixed-path path)
-                        (ctob/set-full-path->set-prefixed-full-path path))
-        prefixed-path-str (ctob/join-set-path prefixed-path)
-        library-data (::library-data (meta changes))
-        prev-token-sets (some-> (get library-data :tokens-lib)
-                                (ctob/get-path-sets prefixed-path-str))]
-    (-> changes
-        (update :redo-changes conj {:type :del-token-set-path :path prefixed-path-str})
-        (update :undo-changes conj {:type :add-token-sets :token-sets prev-token-sets})
-        (apply-changes-local))))
-
-(defn move-token-set-before
+(defn move-token-set
   [changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?] :as opts}]
   (-> changes
-      (update :redo-changes conj {:type :move-token-set-before
+      (update :redo-changes conj {:type :move-token-set
                                   :from-path from-path
                                   :to-path to-path
                                   :before-path before-path
-                                  :before-group? before-group?})
-      (update :undo-changes conj {:type :move-token-set-before
+                                  :before-group before-group?})
+      (update :undo-changes conj {:type :move-token-set
                                   :from-path to-path
                                   :to-path from-path
                                   :before-path prev-before-path
-                                  :before-group? prev-before-group?})
+                                  :before-group prev-before-group?})
       (apply-changes-local)))
 
-(defn move-token-set-group-before
+(defn move-token-set-group
   [changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?]}]
-  (prn prev-before-path prev-before-group?)
   (-> changes
-      (update :redo-changes conj {:type :move-token-set-group-before
+      (update :redo-changes conj {:type :move-token-set-group
                                   :from-path from-path
                                   :to-path to-path
                                   :before-path before-path
-                                  :before-group? before-group?})
-      (update :undo-changes conj {:type :move-token-set-group-before
+                                  :before-group before-group?})
+      (update :undo-changes conj {:type :move-token-set-group
                                   :from-path to-path
                                   :to-path from-path
                                   :before-path prev-before-path
-                                  :before-group? prev-before-group?})
+                                  :before-group prev-before-group?})
       (apply-changes-local)))
 
 (defn set-tokens-lib
@@ -884,36 +848,84 @@
         (update :undo-changes conj {:type :set-tokens-lib :tokens-lib prev-tokens-lib})
         (apply-changes-local))))
 
-(defn add-token
-  [changes set-name token]
-  (-> changes
-      (update :redo-changes conj {:type :add-token :set-name set-name :token token})
-      (update :undo-changes conj {:type :del-token :set-name set-name :name (:name token)})
-      (apply-changes-local)))
-
-(defn update-token
-  [changes set-name token prev-token]
-  (-> changes
-      (update :redo-changes conj {:type :mod-token :set-name set-name :name (:name prev-token) :token token})
-      (update :undo-changes conj {:type :mod-token :set-name set-name :name (:name token) :token (or prev-token token)})
-      (apply-changes-local)))
-
-(defn delete-token
-  [changes set-name token-name]
+(defn set-token [changes set-name token-name token]
   (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-token (some-> (get library-data :tokens-lib)
                            (ctob/get-set set-name)
                            (ctob/get-token token-name))]
     (-> changes
-        (update :redo-changes conj {:type :del-token :set-name set-name :name token-name})
-        (update :undo-changes conj {:type :add-token :set-name set-name :token prev-token})
+        (update :redo-changes conj {:type :set-token
+                                    :set-name set-name
+                                    :token-name token-name
+                                    :token token})
+        (update :undo-changes conj (if prev-token
+                                     {:type :set-token
+                                      :set-name set-name
+                                      :token-name (or
+                                                   ;; Undo of edit
+                                                   (:name token)
+                                                   ;; Undo of delete
+                                                   token-name)
+                                      :token prev-token}
+                                     ;; Undo of create token
+                                     {:type :set-token
+                                      :set-name set-name
+                                      :token-name token-name
+                                      :token nil}))
+        (apply-changes-local))))
+
+(defn rename-token-set
+  [changes name new-name]
+
+  (assert-library! changes)
+  (let [library-data   (::library-data (meta changes))
+        prev-token-set (some-> (get library-data :tokens-lib)
+                               (ctob/get-set name))]
+    (-> changes
+        (update :redo-changes conj {:type :set-token-set
+                                    :set-name name
+                                    :token-set (assoc prev-token-set :name new-name)
+                                    :group? false})
+        (update :undo-changes conj {:type :set-token-set
+                                    :set-name new-name
+                                    :token-set prev-token-set
+                                    :group? false})
+        (apply-changes-local))))
+
+(defn set-token-set
+  [changes set-name group? token-set]
+  (assert-library! changes)
+  (let [library-data   (::library-data (meta changes))
+        prev-token-set (some-> (get library-data :tokens-lib)
+                               (ctob/get-set set-name))]
+    (-> changes
+        (update :redo-changes conj {:type :set-token-set
+                                    :set-name set-name
+                                    :token-set token-set
+                                    :group? group?})
+        (update :undo-changes conj (if prev-token-set
+                                     {:type :set-token-set
+                                      :set-name (or
+                                                 ;; Undo of edit
+                                                 (:name token-set)
+                                                 ;; Undo of delete
+                                                 set-name)
+                                      :token-set prev-token-set
+                                      :group? group?}
+                                     ;; Undo of create
+                                     {:type :set-token-set
+                                      :set-name set-name
+                                      :token-set nil
+                                      :group? group?}))
         (apply-changes-local))))
 
 (defn add-component
   ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page]
-   (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil))
+   (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil nil nil))
   ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation]
+   (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation nil nil))
+  ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation variant-id variant-properties & {:keys [apply-changes-local-library?]}]
    (assert-page-id! changes)
    (assert-objects! changes)
    (let [page-id (::page-id (meta changes))
@@ -952,7 +964,9 @@
                                       :name name
                                       :main-instance-id main-instance-id
                                       :main-instance-page main-instance-page
-                                      :annotation annotation}
+                                      :annotation annotation
+                                      :variant-id variant-id
+                                      :variant-properties variant-properties}
                                (some? new-shapes)  ;; this will be null in components-v2
                                (assoc :shapes (vec new-shapes))))
                        (into (map mk-change) updated-shapes))))
@@ -967,10 +981,10 @@
                                    (map mk-change))
                              updated-shapes))))
 
-         (apply-changes-local)))))
+         (apply-changes-local {:apply-to-library? apply-changes-local-library?})))))
 
 (defn update-component
-  [changes id update-fn]
+  [changes id update-fn & {:keys [apply-changes-local-library?]}]
   (assert-library! changes)
   (let [library-data   (::library-data (meta changes))
         prev-component (get-in library-data [:components id])
@@ -984,6 +998,8 @@
                                       :main-instance-id (:main-instance-id new-component)
                                       :main-instance-page (:main-instance-page new-component)
                                       :annotation (:annotation new-component)
+                                      :variant-id (:variant-id new-component)
+                                      :variant-properties (:variant-properties new-component)
                                       :objects (:objects new-component) ;; this won't exist in components-v2 (except for deleted components)
                                       :modified-at (:modified-at new-component)})
           (update :undo-changes conj {:type :mod-component
@@ -993,7 +1009,11 @@
                                       :main-instance-id (:main-instance-id prev-component)
                                       :main-instance-page (:main-instance-page prev-component)
                                       :annotation (:annotation prev-component)
-                                      :objects (:objects prev-component)}))
+                                      :variant-id (:variant-id prev-component)
+                                      :variant-properties (:variant-properties prev-component)
+                                      :objects (:objects prev-component)})
+          (cond-> apply-changes-local-library?
+            (apply-changes-local {:apply-to-library? true})))
       changes)))
 
 (defn delete-component
@@ -1055,3 +1075,11 @@
              (reduce reorder-grid changes))]
 
     changes))
+
+(defn get-library-data
+  [changes]
+  (::library-data (meta changes)))
+
+(defn get-objects
+  [changes]
+  (dm/get-in (::file-data (meta changes)) [:pages-index uuid/zero :objects]))

common/src/app/common/files/helpers.cljc

@@ -9,7 +9,6 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.shapes.common :as gco]
-   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
    [clojure.walk :as walk]
@@ -201,7 +200,7 @@
         result))))
 
 (defn get-parent-seq
-  "Returns a vector of parents of the specified shape."
+  "Returns a lazy seq of parents of the specified shape."
   ([objects shape-id]
    (get-parent-seq objects (get objects shape-id) shape-id))
 
@@ -284,6 +283,22 @@
       :else
       (get-root-frame objects (:frame-id frame)))))
 
+(defn get-parent-frame
+  "Similar to `get-frame, but always return the parent frame. When root
+  frame is provided, then itself is returned."
+  [objects shape-or-id]
+  (cond
+    (map? shape-or-id)
+    (get objects (dm/get-prop shape-or-id :frame-id))
+
+    (= uuid/zero shape-or-id)
+    (get objects uuid/zero)
+
+    :else
+    (some->> shape-or-id
+             (get objects)
+             (get-frame objects))))
+
 (defn valid-frame-target?
   [objects parent-id shape-id]
   (let [shape (get objects shape-id)]
@@ -400,31 +415,51 @@
                    elements)]
     (into #{} (keep :name) elements)))
 
-(defn- extract-numeric-suffix
-  [basename]
-  (if-let [[_ p1 p2] (re-find #"(.*) ([0-9]+)$" basename)]
-    [p1 (+ 1 (d/parse-integer p2))]
-    [basename 1]))
+(defn- name-seq
+  "Creates a lazy, infinite sequence of names starting with `base-name`,
+   followed by variants with suffixes applied. The sequence follows this pattern:
+   - `base-name`
+   - `(str base-name (suffix-fn 1))`
+   - `(str base-name (suffix-fn 2))`
+   - `(str base-name (suffix-fn 3))`, etc."
+  [base-name suffix-fn]
+  (cons base-name
+        (map #(str/concat base-name (suffix-fn %))
+             (iterate inc 1))))
+
+(defn ^:private get-suffix
+  "Default suffix impelemtation"
+  [copy-count]
+  (str/concat " " copy-count))
 
 (defn generate-unique-name
-  "A unique name generator"
-  [used basename]
+  "Generates a unique name by selecting the first available name from a generated sequence.
+   The sequence consists of `base-name` and its variants, avoiding conflicts with `existing-names`.
+
+   Parameters:
+   - `base-name` - string used as the base for name generation.
+   - `existing-names` - a collection of existing names to check for uniqueness.
+   - Options:
+     - `:suffix-fn` - a function that generates suffixes, given an integer (default: `get-suffix`).
+     - `:immediate-suffix?` - if `true`, the base name is considered taken, and suffixing starts immediately.
+
+   Returns:
+   - A unique name not present in `existing-names`."
+  [base-name existing-names & {:keys [suffix-fn immediate-suffix?]
+                               :or {suffix-fn get-suffix}}]
   (dm/assert!
    "expected a set of strings"
-   (sm/check-set-of-strings! used))
+   (coll? existing-names))
 
   (dm/assert!
    "expected a string for `basename`."
-   (string? basename))
-
-  (if-not (contains? used basename)
-    basename
-    (let [[prefix initial] (extract-numeric-suffix basename)]
-      (loop [counter initial]
-        (let [candidate (str prefix " " counter)]
-          (if (contains? used candidate)
-            (recur (inc counter))
-            candidate))))))
+   (string? base-name))
+  (let [existing-name-set (cond-> (set existing-names)
+                            immediate-suffix? (conj base-name))
+        names (name-seq base-name suffix-fn)]
+    (->> names
+         (remove #(contains? existing-name-set %))
+         first)))
 
 (defn walk-pages
   "Go through all pages of a file and apply a function to each one"

common/src/app/common/files/migrations.cljc

@@ -28,6 +28,7 @@
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
    [app.common.types.shape :as cts]
+   [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
@@ -35,9 +36,7 @@
 
 #?(:cljs (l/set-level! :info))
 
-(declare ^:private available-migrations)
-(declare ^:private migration-up-index)
-(declare ^:private migration-down-index)
+(declare available-migrations)
 
 (def version cfd/version)
 
@@ -49,7 +48,10 @@
   [file]
   (or (nil? (:version file))
       (not= cfd/version (:version file))
-      (not= available-migrations (:migrations file))))
+      (boolean
+       (->> (:migrations file #{})
+            (set/difference available-migrations)
+            (not-empty)))))
 
 (def xf:map-name
   (map :name))
@@ -96,13 +98,13 @@
                     (if (nil? migrations)
                       (generate-migrations-from-version version)
                       migrations)))
-          (migrate)
           (update :features (fnil into #{}) (deref cfeat/*new*))
           ;; NOTE: in some future we can consider to apply
           ;; a migration to the whole database and remove
           ;; this code from this function that executes on
           ;; each file migration operation
-          (update :features cfeat/migrate-legacy-features)))))
+          (update :features cfeat/migrate-legacy-features)
+          (migrate)))))
 
 (defn migrated?
   [file]
@@ -119,9 +121,9 @@
                                (into [] shapes)
                                shapes))))
           (update-page [page]
-            (update page :objects update-vals update-object))]
+            (update page :objects d/update-vals update-object))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 (defmethod migrate-data "legacy-3"
   [data _]
@@ -172,9 +174,9 @@
               (fix-empty-points)))
 
           (update-page [page]
-            (update page :objects update-vals update-object))]
+            (update page :objects d/update-vals update-object))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 ;; Put the id of the local file in :component-file in instances of
 ;; local components
@@ -187,9 +189,9 @@
               object))
 
           (update-page [page]
-            (update page :objects update-vals update-object))]
+            (update page :objects d/update-vals update-object))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 ;; Fixes issues with selrect/points for shapes with width/height =
 ;; 0 (line-like paths)
@@ -212,11 +214,11 @@
               shape))
 
           (update-container [container]
-            (update container :objects update-vals fix-line-paths))]
+            (update container :objects d/update-vals fix-line-paths))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 ;; Remove interactions pointing to deleted frames
 (defmethod migrate-data "legacy-7"
@@ -227,9 +229,9 @@
                              (filterv #(get-in page [:objects (:destination %)]) interactions))))
 
           (update-page [page]
-            (update page :objects update-vals (partial update-object page)))]
+            (update page :objects d/update-vals (partial update-object page)))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 ;; Remove groups without any shape, both in pages and components
 (defmethod migrate-data "legacy-8"
@@ -269,8 +271,8 @@
                   (assoc container :objects objects)))))]
 
     (-> data
-        (update :pages-index update-vals clean-container)
-        (update :components update-vals clean-container))))
+        (update :pages-index d/update-vals clean-container)
+        (d/update-when :components d/update-vals clean-container))))
 
 (defmethod migrate-data "legacy-9"
   [data _]
@@ -304,7 +306,7 @@
   [data _]
   (letfn [(update-page [page]
             (d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))]
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 (defmethod migrate-data "legacy-11"
   [data _]
@@ -318,7 +320,7 @@
             (update page :objects (fn [objects]
                                     (update-vals objects (partial update-object objects)))))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 (defmethod migrate-data "legacy-12"
   [data _]
@@ -328,9 +330,9 @@
               (assoc :size nil)))
 
           (update-page [page]
-            (d/update-in-when page [:options :saved-grids] update-vals update-grid))]
+            (d/update-in-when page [:options :saved-grids] d/update-vals update-grid))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 ;; Add rx and ry to images
 (defmethod migrate-data "legacy-13"
@@ -348,9 +350,9 @@
               (fix-radius)))
 
           (update-page [page]
-            (update page :objects update-vals update-object))]
+            (update page :objects d/update-vals update-object))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 (defmethod migrate-data "legacy-14"
   [data _]
@@ -380,8 +382,8 @@
               container))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-16"
   [data _]
@@ -423,11 +425,11 @@
               (assign-fills)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-17"
   [data _]
@@ -452,11 +454,11 @@
               (assoc :fills [])))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 ;; Remove position-data to solve a bug with the text positioning
 (defmethod migrate-data "legacy-18"
@@ -467,11 +469,11 @@
               (dissoc :position-data)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-19"
   [data _]
@@ -483,11 +485,11 @@
               (dissoc :position-data)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-25"
   [data _]
@@ -499,10 +501,10 @@
                   (update :selrect grc/make-rect)
                   (cts/create-shape))))
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-26"
   [data _]
@@ -515,11 +517,11 @@
               (assoc :transform-inverse (gmt/matrix))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-27"
   [data _]
@@ -546,11 +548,11 @@
                   (dissoc :saved-component-root?))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-28"
   [data _]
@@ -575,8 +577,8 @@
             (d/update-when container :objects #(update-vals % (partial update-object %))))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-29"
   [data _]
@@ -607,11 +609,11 @@
                 (update :content #(txt/transform-nodes invalid-node? fix-node %)))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-31"
   [data _]
@@ -622,10 +624,10 @@
                   (dissoc :use-for-thumbnail?))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-32"
   [data _]
@@ -640,11 +642,11 @@
                 object)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-33"
   [data _]
@@ -662,9 +664,9 @@
               object))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container))))
+        (update :pages-index d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-34"
   [data _]
@@ -674,10 +676,10 @@
               (dissoc object :x :y :width :height)
               object))
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-36"
   [data _]
@@ -687,8 +689,8 @@
                                                   (dissoc objects nil)
                                                   objects))))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-37"
   [data _]
@@ -716,11 +718,11 @@
                 shape)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-39"
   [data _]
@@ -738,11 +740,11 @@
               shape))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-40"
   [data _]
@@ -762,11 +764,11 @@
               shape))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-41"
   [data _]
@@ -795,11 +797,11 @@
               shape))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-42"
   [data _]
@@ -812,11 +814,11 @@
               object))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (def ^:private valid-fill?
   (sm/lazy-validator ::cts/fill))
@@ -841,14 +843,11 @@
               object))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/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))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-44"
   [data _]
@@ -861,14 +860,14 @@
 
           (update-object [object]
             (let [xform (comp (map fix-shadow)
-                              (filter valid-shadow?))]
+                              (filter ctss/valid-shadow?))]
               (d/update-when object :shadow #(into [] xform %))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-45"
   [data _]
@@ -881,9 +880,9 @@
                      :parent-id parent-id)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals fix-shape))]
+            (d/update-when container :objects d/update-vals fix-shape))]
     (-> data
-        (update :pages-index update-vals update-container))))
+        (update :pages-index d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-46"
   [data _]
@@ -891,10 +890,10 @@
             (dissoc object :thumbnail))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-47"
   [data _]
@@ -915,9 +914,9 @@
                 shape)))
 
           (update-page [page]
-            (d/update-when page :objects update-vals (partial fix-shape page)))]
+            (d/update-when page :objects d/update-vals (partial fix-shape page)))]
     (-> data
-        (update :pages-index update-vals update-page))))
+        (update :pages-index d/update-vals update-page))))
 
 (defmethod migrate-data "legacy-48"
   [data _]
@@ -929,9 +928,9 @@
                 shape)))
 
           (update-page [page]
-            (d/update-when page :objects update-vals fix-shape))]
+            (d/update-when page :objects d/update-vals fix-shape))]
     (-> data
-        (update :pages-index update-vals update-page))))
+        (update :pages-index d/update-vals update-page))))
 
 ;; Remove hide-in-viewer for shapes that are origin or destination of an interaction
 (defmethod migrate-data "legacy-49"
@@ -949,9 +948,9 @@
                                     (mapcat :interactions)
                                     (map :destination)
                                     (set))]
-              (update page :objects update-vals (partial update-object destinations))))]
+              (update page :objects d/update-vals (partial update-object destinations))))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 ;; This migration mainly fixes paths with curve-to segments
 ;; without :c1x :c1y :c2x :c2y properties. Additionally, we found a
@@ -994,11 +993,11 @@
 
         update-container
         (fn [page]
-          (d/update-when page :objects update-vals update-shape))]
+          (d/update-when page :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (def ^:private valid-color?
   (sm/lazy-validator ::ctc/color))
@@ -1018,9 +1017,9 @@
               shape))
 
           (update-page [page]
-            (d/update-when page :objects update-vals update-shape))]
+            (d/update-when page :objects d/update-vals update-shape))]
 
-    (update data :pages-index update-vals update-page)))
+    (update data :pages-index d/update-vals update-page)))
 
 
 (defmethod migrate-data "legacy-53"
@@ -1036,15 +1035,15 @@
 
           (update-shape [shape]
             (let [xform (comp (map fix-shadow)
-                              (filter valid-shadow?))]
+                              (filter ctss/valid-shadow?))]
               (d/update-when shape :shadow #(into [] xform %))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 ;; This migration moves page options to the page level
 (defmethod migrate-data "legacy-55"
@@ -1096,11 +1095,11 @@
                   (update :content (partial txt/transform-nodes identity fix-fills)))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 
 (defmethod migrate-data "legacy-57"
@@ -1127,7 +1126,7 @@
     (-> data
         (update :pages (fn [pages] (into [] (remove nil?) pages)))
         (update :pages-index dissoc nil)
-        (update :pages-index update-vals update-page))))
+        (update :pages-index d/update-vals update-page))))
 
 (defmethod migrate-data "legacy-59"
   [data _]
@@ -1138,11 +1137,11 @@
             (d/update-when shape :touched #(into #{} (map fix-touched) %)))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-shape))]
+            (d/update-when container :objects d/update-vals update-shape))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-62"
   [data _]
@@ -1175,7 +1174,7 @@
           ;; so the relevant objects are inside the component
           (d/update-when component :objects remove-cycles))]
 
-    (update data :components update-vals update-component)))
+    (d/update-when data :components d/update-vals update-component)))
 
 (defmethod migrate-data "legacy-65"
   [data _]
@@ -1186,14 +1185,14 @@
         update-page
         (fn [page]
           (-> (update-object page)
-              (update :objects update-vals update-object)))]
+              (update :objects d/update-vals update-object)))]
 
     (-> data
         (update-object)
-        (d/update-when :pages-index update-vals update-page)
-        (d/update-when :colors update-vals update-object)
-        (d/update-when :typographies update-vals update-object)
-        (d/update-when :components update-vals update-object))))
+        (update :pages-index d/update-vals update-page)
+        (d/update-when :colors d/update-vals update-object)
+        (d/update-when :typographies d/update-vals update-object)
+        (d/update-when :components d/update-vals update-object))))
 
 (defmethod migrate-data "legacy-66"
   [data _]
@@ -1207,11 +1206,11 @@
               object))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "legacy-67"
   [data _]
@@ -1219,11 +1218,73 @@
             (d/update-when object :shadow #(into [] (reverse %))))
 
           (update-container [container]
-            (d/update-when container :objects update-vals update-object))]
+            (d/update-when container :objects d/update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
+(defmethod migrate-data "0001-remove-tokens-from-groups"
+  [data _]
+  (letfn [(update-object [object]
+            (cond-> object
+              (and (= :group (:type object))
+                   (contains? (:applied-tokens object) :fill))
+              (assoc :fills [])
+              (and (= :group (:type object))
+                   (contains? object :applied-tokens))
+              (dissoc :applied-tokens)))
+
+          (update-page [page]
+            (d/update-when page :objects d/update-vals update-object))]
+
+    (update data :pages-index d/update-vals update-page)))
+
+(defmethod migrate-data "0002-clean-shape-interactions"
+  [data _]
+  (let [decode-fn   (sm/decoder ctsi/schema:interaction sm/json-transformer)
+        validate-fn (sm/validator ctsi/schema:interaction)
+
+        xform
+        (comp
+         (map decode-fn)
+         (filter validate-fn))
+
+        update-object
+        (fn [object]
+          (d/update-when object :interactions
+                         (fn [interactions]
+                           (into [] xform interactions))))
+
+        update-container
+        (fn [container]
+          (d/update-when container :objects d/update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
+(defmethod migrate-data "0003-fix-root-shape"
+  [data _]
+  (letfn [(update-object [shape]
+            (if (= (:id shape) uuid/zero)
+              (-> shape
+                  (assoc :parent-id uuid/zero)
+                  (assoc :frame-id uuid/zero)
+                  ;; We explicitly dissoc them and let the shape-setup
+                  ;; to regenerate it with valid values.
+                  (dissoc :selrect)
+                  (dissoc :points)
+                  (cts/setup-shape))
+              shape))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container)
+        (d/without-nils))))
 
 (def available-migrations
   (into (d/ordered-set)
@@ -1278,4 +1339,7 @@
          "legacy-62"
          "legacy-65"
          "legacy-66"
-         "legacy-67"]))
+         "legacy-67"
+         "0001-remove-tokens-from-groups"
+         "0002-clean-shape-interactions"
+         "0003-fix-root-shape"]))

common/src/app/common/files/shapes_helpers.cljc

@@ -38,7 +38,7 @@
     [shape changes]))
 
 (defn prepare-move-shapes-into-frame
-  [changes frame-id shapes objects]
+  [changes frame-id shapes objects remove-layout-data?]
   (let [parent-id  (dm/get-in objects [frame-id :parent-id])
         shapes     (remove #(= % parent-id) shapes)
         to-move    (->> shapes
@@ -46,7 +46,8 @@
                         (not-empty))]
     (if to-move
       (-> changes
-          (cond-> (not (ctl/any-layout? objects frame-id))
+          (cond-> (and remove-layout-data?
+                       (not (ctl/any-layout? objects frame-id)))
             (pcb/update-shapes shapes ctl/remove-layout-item-data))
           (pcb/update-shapes shapes #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true)))
           (pcb/change-parent frame-id to-move 0)
@@ -133,7 +134,7 @@
            (prepare-add-shape changes shape objects)
 
            changes
-           (prepare-move-shapes-into-frame changes (:id shape) selected' objects)
+           (prepare-move-shapes-into-frame changes (:id shape) selected' objects false)
 
            changes
            (cond-> changes

common/src/app/common/flags.cljc

@@ -124,7 +124,8 @@
     ;; TODO: deprecate this flag and consolidate the code
     :export-file-v3
     :render-wasm-dpr
-    :hide-release-modal})
+    :hide-release-modal
+    :subscriptions-old})
 
 (def all-flags
   (set/union email login varia))

common/src/app/common/logic/libraries.cljc

@@ -5,6 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.logic.libraries
+  #?(:cljs (:require-macros [app.common.logic.libraries :refer [shape-log container-log]]))
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
@@ -35,6 +36,35 @@
 ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
 (log/set-level! :warn)
 
+;; Add uuids here to filter logs to only show specific shapes or containers (and all shapes
+;; contained in them).
+(def log-shape-ids #{})
+(def log-container-ids #{})
+
+(defn enabled-shape?
+  [id container]
+  (or (empty? log-shape-ids)
+      (nil? id)
+      (let [ids (if container
+                  (into #{} (cfh/get-parent-ids-seq-with-self (:objects container) id))
+                  #{id})]
+        (seq (set/intersection log-shape-ids ids)))))
+
+(defmacro shape-log
+  [level id container & params]
+  `(when (enabled-shape? ~id ~container)
+     (log/log ~level ~@params)))
+
+(defn enabled-container?
+  [id]
+  (or (empty? log-container-ids)
+      (log-container-ids id)))
+
+(defmacro container-log
+  [level id & params]
+  `(when (enabled-container? ~id)
+     (log/log ~level ~@params)))
+
 (declare generate-sync-container)
 (declare generate-sync-shape)
 (declare generate-sync-text-shape)
@@ -72,10 +102,10 @@
 
 ;; ---- Components and instances creation ----
 
-(defn duplicate-component
+(defn- duplicate-component
   "Clone the root shape of the component and all children. Generate new
   ids from all of them."
-  [component new-component-id library-data]
+  [component new-component-id library-data force-id]
   (let [components-v2 (dm/get-in library-data [:options :components-v2])]
     (if components-v2
       (let [main-instance-page  (ctf/get-component-page library-data component)
@@ -111,7 +141,8 @@
                               (:parent-id main-instance-shape)
                               (:objects main-instance-page)
                               :update-new-shape update-new-shape
-                              :update-original-shape update-original-shape)
+                              :update-original-shape update-original-shape
+                              :force-id force-id)
 
             remap-frame
             (fn [shape]
@@ -151,7 +182,7 @@
 
 (defn generate-duplicate-component
   "Create a new component copied from the one with the given id."
-  [changes library component-id components-v2]
+  [changes library component-id new-component-id components-v2 & {:keys [new-shape-id apply-changes-local-library?]}]
   (let [component          (ctkl/get-component (:data library) component-id)
         new-name           (:name component)
 
@@ -159,26 +190,39 @@
                              (ctf/get-component-page (:data library) component))
 
         new-component-id   (when components-v2
-                             (uuid/next))
+                             new-component-id)
 
         [new-component-shape new-component-shapes  ; <- null in components-v2
          new-main-instance-shape new-main-instance-shapes]
-        (duplicate-component component new-component-id (:data library))]
+        (duplicate-component component new-component-id (:data library) new-shape-id)]
+
+    [new-main-instance-shape
+     (-> changes
+         (pcb/with-page main-instance-page)
+         (pcb/with-objects (:objects main-instance-page))
+         (pcb/add-objects new-main-instance-shapes {:ignore-touched true})
+         (pcb/add-component (if components-v2
+                              new-component-id
+                              (:id new-component-shape))
+                            (:path component)
+                            new-name
+                            new-component-shapes
+                            []
+                            (:id new-main-instance-shape)
+                            (:id main-instance-page)
+                            (:annotation component)
+                            (:variant-id component)
+                            (:variant-properties component)
+                            {:apply-changes-local-library? apply-changes-local-library?})
+         ;; Update grid layout if the new main instance is inside
+         (pcb/update-shapes
+          [(:frame-id new-main-instance-shape)]
+          (fn [shape objects]
+            (cond-> shape
+              (ctl/grid-layout? shape)
+              (ctl/assign-cells objects)))
+          {:with-objects? true}))]))
 
-    (-> changes
-        (pcb/with-page main-instance-page)
-        (pcb/with-objects (:objects main-instance-page))
-        (pcb/add-objects new-main-instance-shapes {:ignore-touched true})
-        (pcb/add-component (if components-v2
-                             new-component-id
-                             (:id new-component-shape))
-                           (:path component)
-                           new-name
-                           new-component-shapes
-                           []
-                           (:id new-main-instance-shape)
-                           (:id main-instance-page)
-                           (:annotation component)))))
 
 (defn generate-instantiate-component
   "Generate changes to create a new instance from a component."
@@ -251,72 +295,98 @@
 
 (declare generate-detach-recursive)
 (declare generate-advance-nesting-level)
+(declare generate-detach-immediate)
 
 (defn generate-detach-instance
   "Generate changes to remove the links between a shape and all its children
   with a component."
   [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))
+    (shape-log :debug shape-id container
+               :msg "Detach instance" :shape-id shape-id :container (:id container))
     (generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape)))))
 
 (defn- generate-detach-recursive
   [changes container libraries shape-id first component-root?]
   (let [shape (ctn/get-shape container shape-id)]
+    (shape-log :trace shape-id container
+               :msg "  Processing" :shape-id shape-id)
     (if (and (ctk/instance-head? shape) (not first))
       ; 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))
+        (pcb/update-shapes [shape-id] #(do (log/trace :msg "  -> promote to root")
+                                           (assoc % :component-root true)))
 
         :always
         ; First level subinstances of a detached component can't have swap-slot
-        (pcb/update-shapes [shape-id] ctk/remove-swap-slot)
+        (pcb/update-shapes [shape-id] #(do (log/trace :msg "  -> remove swap-slot")
+                                           (ctk/remove-swap-slot %)))
 
         (nil? (ctk/get-swap-slot shape))
-        ; Near shape-refs need to be advanced one level (except if the head is already swapped)
+        ; Near shape-ref of shape and children need to be advanced one level
+        ; (except if the head is already swapped)
         (generate-advance-nesting-level nil container libraries (:id shape)))
 
       ;; Otherwise, detach the shape and all children
       (let [children-ids (:shapes shape)]
+        (log/trace :msg "  -> detach")
         (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})]
-                      (cond-> changes
-                        (some? (:shape-ref ref-shape))
-                        (pcb/update-shapes [(:id shape)] #(assoc % :shape-ref (:shape-ref ref-shape)))
+  (log/trace :msg "  -> advance-nesting-level")
+  (let [detached-ids (atom #{})
+        children  (cfh/get-children-with-self (:objects container) shape-id)  ;; TODO: this function should be refactored to be a recursive tree traversal.
+        skip-near (fn [changes shape]                                         ;;       this way we could shake the tree more easily when detaching shapes
+                    (shape-log :trace (:id shape) container                   ;;       and perhaps even allow to recover nested instances that have been
+                               :msg "     * advancing" :shape-id (:id shape)) ;;       swapped and so we can access the main instance again.
+                    (if (contains? @detached-ids (:id shape))
+                      (do (log/trace :msg "       (detached)")
+                          changes)
+                      (let [ref-shape (ctf/find-ref-shape file container libraries shape {:include-deleted? true})]
+                        (cond-> changes
+                          (some? (:shape-ref ref-shape))
+                          (pcb/update-shapes [(:id shape)] #(do (log/trace :msg "       (advanced)")
+                                                                (assoc % :shape-ref (:shape-ref ref-shape))))
 
-                        ;; When advancing level, the normal touched groups (not swap slots) of the
-                        ;; ref-shape must be merged into the current shape, because they refer to
-                        ;; the new referenced shape.
-                        (some? ref-shape)
-                        (pcb/update-shapes
-                         [(:id shape)]
-                         #(assoc % :touched
-                                 (clojure.set/union (:touched shape)
-                                                    (ctk/normal-touched-groups ref-shape))))
+                          ;; When advancing level, the normal touched groups (not swap slots) of the
+                          ;; ref-shape must be merged into the current shape, because they refer to
+                          ;; the new referenced shape.
+                          (some? ref-shape)
+                          (pcb/update-shapes
+                           [(:id shape)]
+                           #(do (log/trace :msg "       (merge touched)")
+                                (assoc % :touched
+                                       (clojure.set/union (:touched shape)
+                                                          (ctk/normal-touched-groups ref-shape)))))
 
-                        ;; Swap slot must also be copied if the current shape has not any,
-                        ;; except if this is the first level subcopy.
-                        (and (some? (ctk/get-swap-slot ref-shape))
-                             (nil? (ctk/get-swap-slot shape))
-                             (not= (:id shape) shape-id))
-                        (pcb/update-shapes [(:id shape)] #(ctk/set-swap-slot % (ctk/get-swap-slot ref-shape)))
+                          ;; Swap slot must also be copied if the current shape has not any,
+                          ;; except if this is the first level subcopy.
+                          (and (some? (ctk/get-swap-slot ref-shape))
+                               (nil? (ctk/get-swap-slot shape))
+                               (not= (:id shape) shape-id))
+                          (pcb/update-shapes [(:id shape)] #(do (log/trace :msg "       (got swap-slot)")
+                                                                (ctk/set-swap-slot % (ctk/get-swap-slot ref-shape))))
 
-                        ;; If we can't get the ref-shape (e.g. it's in an external library not linked),
-                        ;: we can't do a suitable advance. So it's better to detach the shape
-                        (nil? ref-shape)
-                        (pcb/update-shapes [(:id shape)] ctk/detach-shape))))]
+                          ;; If we can't get the ref-shape (e.g. it's in an external library not linked),
+                          ;: we can't do a suitable advance. So it's better to detach the shape and all its
+                          ;; children (and add to detached-ids so they are not processed again).
+                          (nil? ref-shape)
+                          (generate-detach-immediate container (:id shape) detached-ids)))))]
 
     (reduce skip-near changes children)))
 
+(defn- generate-detach-immediate
+  [changes container shape-id detached-ids]
+  (let [shape-and-children (cfh/get-children-ids-with-self (:objects container) shape-id)]
+    (log/trace :msg "       (cannot advance; detach shape and children)")
+    (swap! detached-ids #(into % shape-and-children))
+    (pcb/update-shapes changes shape-and-children ctk/detach-shape)))
+
 (defn prepare-restore-component
   ([changes library-data component-id current-page]
    (let [component    (ctkl/get-deleted-component library-data component-id)
@@ -374,11 +444,12 @@
   (s/assert ::us/uuid file-id)
   (s/assert ::us/uuid library-id)
 
-  (log/info :msg "Sync file with library"
-            :asset-type asset-type
-            :asset-id asset-id
-            :file (pretty-file file-id libraries current-file-id)
-            :library (pretty-file library-id libraries current-file-id))
+  (container-log :info asset-id
+                 :msg "Sync file with library"
+                 :asset-type asset-type
+                 :asset-id asset-id
+                 :file (pretty-file file-id libraries current-file-id)
+                 :library (pretty-file library-id libraries current-file-id))
 
   (let [file          (get-in libraries [file-id :data])
         components-v2 (get-in file [:options :components-v2])]
@@ -412,11 +483,12 @@
   (s/assert ::us/uuid file-id)
   (s/assert ::us/uuid library-id)
 
-  (log/info :msg "Sync local components with library"
-            :asset-type asset-type
-            :asset-id asset-id
-            :file (pretty-file file-id libraries current-file-id)
-            :library (pretty-file library-id libraries current-file-id))
+  (container-log :info asset-id
+                 :msg "Sync local components with library"
+                 :asset-type asset-type
+                 :asset-id asset-id
+                 :file (pretty-file file-id libraries current-file-id)
+                 :library (pretty-file library-id libraries current-file-id))
 
   (let [file          (get-in libraries [file-id :data])
         components-v2 (get-in file [:options :components-v2])]
@@ -442,8 +514,8 @@
   [changes asset-type asset-id library-id container components-v2 libraries current-file-id]
 
   (if (cfh/page? container)
-    (log/debug :msg "Sync page in local file" :page-id (:id container))
-    (log/debug :msg "Sync component in local library" :component-id (:id container)))
+    (container-log :debug (:id container) :msg "Sync page in local file" :page-id (:id container))
+    (container-log :debug (:id container) :msg "Sync component in local library" :component-id (:id container)))
 
   (let [linked-shapes (->> (vals (:objects container))
                            (filter #(uses-assets? asset-type asset-id % library-id)))]
@@ -498,7 +570,7 @@
 
 (defmethod generate-sync-shape :colors
   [_ changes library-id _ shape _ libraries _]
-  (log/debug :msg "Sync colors of shape" :shape (:name shape))
+  (shape-log :debug (:id shape) nil :msg "Sync colors of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some colors of the library. The value of the
   ;; color in the library is copied to the shape.
@@ -509,7 +581,7 @@
 
 (defmethod generate-sync-shape :typographies
   [_ changes library-id container shape _ libraries _]
-  (log/debug :msg "Sync typographies of shape" :shape (:name shape))
+  (shape-log :debug (:id shape) nil :msg "Sync typographies of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some typographies of the library. The attributes
   ;; of the typography are copied to the shape."
@@ -671,7 +743,8 @@
   "Generate changes to synchronize one shape that is the root of a component
   instance, and all its children, from the given component."
   [changes file libraries container shape-id reset? components-v2]
-  (log/debug :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?)
+  (shape-log :debug shape-id container
+             :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?)
   (let [shape-inst (ctn/get-shape container shape-id)
         library    (dm/get-in libraries [(:component-file shape-inst) :data])
         component  (ctkl/get-component library (:component-id shape-inst) true)]
@@ -735,7 +808,8 @@
 
 (defn- generate-sync-shape-direct-recursive
   [changes container shape-inst component library file libraries shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2]
-  (log/debug :msg "Sync shape direct recursive"
+  (shape-log :debug (:id shape-inst) container
+             :msg "Sync shape direct recursive"
              :shape-inst (str (:name shape-inst) " " (pretty-uuid (:id shape-inst)))
              :component (:name component))
 
@@ -786,7 +860,8 @@
                           (map #(redirect-shaperef %) children-inst) children-inst)
 
           only-inst (fn [changes child-inst]
-                      (log/trace :msg "Only inst"
+                      (shape-log :trace (:id child-inst) container
+                                 :msg "Only inst"
                                  :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
                       (if-not (and omit-touched?
                                    (contains? (:touched shape-inst)
@@ -798,7 +873,8 @@
                         changes))
 
           only-main (fn [changes child-main]
-                      (log/trace :msg "Only main"
+                      (shape-log :trace (:id child-main) component-container
+                                 :msg "Only main"
                                  :child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
                       (if-not (and omit-touched?
                                    (contains? (:touched shape-inst)
@@ -817,7 +893,8 @@
                         changes))
 
           both (fn [changes child-inst child-main]
-                 (log/trace :msg "Both"
+                 (shape-log :trace (:id child-inst) container
+                            :msg "Both"
                             :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
                             :child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
                  (generate-sync-shape-direct-recursive changes
@@ -836,14 +913,16 @@
                                                        components-v2))
 
           swapped (fn [changes child-inst child-main]
-                    (log/trace :msg "Match slot"
+                    (shape-log :trace (:id child-inst) container
+                               :msg "Match slot"
                                :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
                                :child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
                     ;; For now we don't make any sync here.
                     changes)
 
           moved (fn [changes child-inst child-main]
-                  (log/trace :msg "Move"
+                  (shape-log :trace (:id child-inst) container
+                             :msg "Move"
                              :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
                              :child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
                   (move-shape
@@ -856,6 +935,7 @@
 
           changes
           (compare-children changes
+                            shape-inst
                             children-inst
                             children-main
                             container
@@ -906,7 +986,7 @@
   "Generate changes to update the component a shape is linked to, from
   the values in the shape and all its children."
   [changes file libraries container shape-id components-v2]
-  (log/debug :msg "Sync shape inverse" :shape (str shape-id))
+  (shape-log :debug shape-id container :msg "Sync shape inverse" :shape (str shape-id))
   (let [redirect-shaperef (partial redirect-shaperef container libraries)
         shape-inst     (ctn/get-shape container shape-id)
         library        (dm/get-in libraries [(:component-file shape-inst) :data])
@@ -948,7 +1028,8 @@
 
 (defn- generate-sync-shape-inverse-recursive
   [changes container shape-inst component library file libraries shape-main root-inst root-main initial-root? redirect-shaperef components-v2]
-  (log/trace :msg "Sync shape inverse recursive"
+  (shape-log :trace (:id shape-inst) container
+             :msg "Sync shape inverse recursive"
              :shape (str (:name shape-inst))
              :component (:name component))
 
@@ -1041,7 +1122,8 @@
                                                         components-v2))
 
           swapped (fn [changes child-inst child-main]
-                    (log/trace :msg "Match slot"
+                    (shape-log :trace (:id child-inst) container
+                               :msg "Match slot"
                                :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
                                :child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
                     ;; For now we don't make any sync here.
@@ -1058,6 +1140,7 @@
 
           changes
           (compare-children changes
+                            shape-inst
                             children-inst
                             children-main
                             container
@@ -1089,14 +1172,15 @@
 ;; ---- Operation generation helpers ----
 
 (defn- compare-children
-  [changes children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2]
-  (log/trace :msg "Compare children")
+  [changes shape-inst children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2]
+  (shape-log :trace (:id shape-inst) container-inst :msg "Compare children")
   (loop [children-inst (seq (or children-inst []))
          children-main (seq (or children-main []))
          changes       changes]
     (let [child-inst (first children-inst)
           child-main (first children-main)]
-      (log/trace :main (str (:name child-main) " " (pretty-uuid (:id child-main)))
+      (shape-log :trace (:id shape-inst) container-inst
+                 :main (str (:name child-main) " " (pretty-uuid (:id child-main)))
                  :inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
       (cond
         (and (nil? child-inst) (nil? child-main))
@@ -1159,10 +1243,11 @@
 
 (defn- add-shape-to-instance
   [changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced? components-v2]
-  (log/info :msg (str "ADD [P " (pretty-uuid (:id container)) "] "
-                      (:name component-shape)
-                      " "
-                      (pretty-uuid (:id component-shape))))
+  (shape-log :info (:id component-shape) component-page
+             :msg (str "ADD [P " (pretty-uuid (:id container)) "] "
+                       (:name component-shape)
+                       " "
+                       (pretty-uuid (:id component-shape))))
   (let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape))
         parent-shape           (d/seek #(ctk/is-main-of? component-parent-shape % components-v2)
                                        (cfh/get-children-with-self (:objects container)
@@ -1234,10 +1319,11 @@
 
 (defn- add-shape-to-main
   [changes shape index component component-container page root-instance root-main components-v2]
-  (log/info :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] "
-                      (:name shape)
-                      " "
-                      (pretty-uuid (:id shape))))
+  (shape-log :info (:id shape) page
+             :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] "
+                       (:name shape)
+                       " "
+                       (pretty-uuid (:id shape))))
   (let [parent-shape           (ctn/get-shape page (:parent-id shape))
         component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape components-v2)
                                        (cfh/get-children-with-self (:objects component-container)
@@ -1337,12 +1423,13 @@
 
 (defn- remove-shape
   [changes shape container omit-touched?]
-  (log/info :msg (str "REMOVE-SHAPE "
-                      (if (cfh/page? container) "[P " "[C ")
-                      (pretty-uuid (:id container)) "] "
-                      (:name shape)
-                      " "
-                      (pretty-uuid (:id shape))))
+  (shape-log :info (:id shape) container
+             :msg (str "REMOVE-SHAPE "
+                       (if (cfh/page? container) "[P " "[C ")
+                       (pretty-uuid (:id container)) "] "
+                       (:name shape)
+                       " "
+                       (pretty-uuid (:id shape))))
   (let [objects    (get container :objects)
         parents    (cfh/get-parent-ids objects (:id shape))
         parent     (first parents)
@@ -1389,16 +1476,17 @@
 
 (defn- move-shape
   [changes shape index-before index-after container omit-touched?]
-  (log/info :msg (str "MOVE "
-                      (if (cfh/page? container) "[P " "[C ")
-                      (pretty-uuid (:id container)) "] "
-                      (:name shape)
-                      " "
-                      (pretty-uuid (:id shape))
-                      " "
-                      index-before
-                      " -> "
-                      index-after))
+  (shape-log :info (:id shape) container
+             :msg (str "MOVE "
+                       (if (cfh/page? container) "[P " "[C ")
+                       (pretty-uuid (:id container)) "] "
+                       (:name shape)
+                       " "
+                       (pretty-uuid (:id shape))
+                       " "
+                       index-before
+                       " -> "
+                       index-after))
   (let [parent (ctn/get-shape container (:parent-id shape))
 
         changes' (-> changes
@@ -1429,13 +1517,14 @@
   (if (nil? (:shape-ref dest-shape))
     changes
     (do
-      (log/info :msg (str "CHANGE-TOUCHED "
-                          (if (cfh/page? container) "[P " "[C ")
-                          (pretty-uuid (:id container)) "] "
-                          (:name dest-shape)
-                          " "
-                          (pretty-uuid (:id dest-shape)))
-                :options options)
+      (shape-log :info (:id dest-shape) container
+                 :msg (str "CHANGE-TOUCHED "
+                           (if (cfh/page? container) "[P " "[C ")
+                           (pretty-uuid (:id container)) "] "
+                           (:name dest-shape)
+                           " "
+                           (pretty-uuid (:id dest-shape)))
+                 :options options)
       (let [new-touched (cond
                           reset-touched?
                           nil
@@ -1471,13 +1560,14 @@
   (if (nil? (:shape-ref shape))
     changes
     (do
-      (log/info :msg (str "CHANGE-REMOTE-SYNCED? "
-                          (if (cfh/page? container) "[P " "[C ")
-                          (pretty-uuid (:id container)) "] "
-                          (:name shape)
-                          " "
-                          (pretty-uuid (:id shape)))
-                :remote-synced remote-synced?)
+      (shape-log :info (:id shape) container
+                 :msg (str "CHANGE-REMOTE-SYNCED? "
+                           (if (cfh/page? container) "[P " "[C ")
+                           (pretty-uuid (:id container)) "] "
+                           (:name shape)
+                           " "
+                           (pretty-uuid (:id shape)))
+                 :remote-synced remote-synced?)
       (-> changes
           (update :redo-changes conj (make-change
                                       container
@@ -1540,16 +1630,17 @@
   in the destination shape will not be copied."
   [changes dest-shape origin-shape dest-root origin-root container omit-touched?]
 
-  (log/info :msg (str "SYNC "
-                      (:name origin-shape)
-                      " "
-                      (pretty-uuid (:id origin-shape))
-                      " -> "
-                      (if (cfh/page? container) "[P " "[C ")
-                      (pretty-uuid (:id container)) "] "
-                      (:name dest-shape)
-                      " "
-                      (pretty-uuid (:id dest-shape))))
+  (shape-log :info (:id dest-shape) container
+             :msg (str "SYNC "
+                       (:name origin-shape)
+                       " "
+                       (pretty-uuid (:id origin-shape))
+                       " -> "
+                       (if (cfh/page? container) "[P " "[C ")
+                       (pretty-uuid (:id container)) "] "
+                       (:name dest-shape)
+                       " "
+                       (pretty-uuid (:id dest-shape))))
 
   (let [;; To synchronize geometry attributes we need to make a prior
         ;; operation, because coordinates are absolute, but we need to
@@ -1575,7 +1666,21 @@
           (if (and (empty? roperations) (empty? applied-tokens))
             changes
             (let [all-parents (cfh/get-parent-ids (:objects container)
-                                                  (:id dest-shape))]
+                                                  (:id dest-shape))
+
+                  ;; Sync tokens of attributes ignored above.
+                  ;; FIXME: this probably may be merged with the other calculation
+                  ;;        of applied tokens, below, and to the calculation only once
+                  ;;        for all sync-attrs.
+                  applied-tokens (reduce (fn [applied-tokens attr]
+                                           (let [attr-group (get ctk/sync-attrs attr)
+                                                 token-attrs (cto/shape-attr->token-attrs attr)]
+                                             (if (not (and (touched attr-group)
+                                                           omit-touched?))
+                                               (into applied-tokens token-attrs)
+                                               applied-tokens)))
+                                         applied-tokens
+                                         ctk/swap-keep-attrs)]
               (cond-> changes
                 (seq roperations)
                 (-> (update :redo-changes conj (make-change
@@ -2037,7 +2142,7 @@
         has-flow?        (partial ctp/get-frame-flow flows)]
 
     (reduce (fn [changes frame-id]
-              (let [name     (cfh/generate-unique-name @unames "Flow 1")
+              (let [name     (cfh/generate-unique-name "Flow" @unames :immediate-suffix? true)
                     frame-id (get ids-map frame-id)
                     flow-id  (uuid/next)
                     new-flow {:id flow-id

common/src/app/common/logic/shapes.cljc

@@ -10,12 +10,14 @@
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cfh]
    [app.common.geom.shapes :as gsh]
+   [app.common.logic.variants :as clv]
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctl]
    [app.common.types.token :as cto]
-   [app.common.uuid :as uuid]))
+   [app.common.uuid :as uuid]
+   [cuerdas.core :as str]))
 
 (defn- generate-unapply-tokens
   "When updating attributes that have a token applied, we must unapply it, because the value
@@ -239,21 +241,21 @@
 
 
 (defn generate-relocate
-  [changes objects parent-id page-id to-index ids & {:keys [cell ignore-parents?]}]
-  (let [ids    (cfh/order-by-indexed-shapes objects ids)
-        shapes (map (d/getf objects) ids)
-        parent (get objects parent-id)
+  [changes parent-id to-index ids & {:keys [cell ignore-parents?]}]
+  (let [objects     (pcb/get-objects changes)
+        ids         (cfh/order-by-indexed-shapes objects ids)
+        shapes      (map (d/getf objects) ids)
+        parent      (get objects parent-id)
         all-parents (into #{parent-id} (map #(cfh/get-parent-id objects %)) ids)
-        parents  (if ignore-parents? #{parent-id} all-parents)
+        parents     (if ignore-parents? #{parent-id} all-parents)
 
-        children-ids
-        (->> ids
-             (mapcat #(cfh/get-children-ids-with-self objects %)))
+        children-ids (mapcat #(cfh/get-children-ids-with-self objects %) ids)
 
-        child-heads
-        (->> ids
-             (mapcat #(ctn/get-child-heads objects %))
-             (map :id))
+        child-heads (mapcat #(ctn/get-child-heads objects %) ids)
+
+        child-heads-ids (map :id child-heads)
+
+        variant-heads (filter ctk/is-variant? child-heads)
 
         component-main-parent
         (ctn/find-component-main objects parent false)
@@ -340,9 +342,6 @@
         cell (or cell (and index-cell-data [(:row index-cell-data) (:column index-cell-data)]))]
 
     (-> changes
-        (pcb/with-page-id page-id)
-        (pcb/with-objects objects)
-
         ;; Remove layout-item properties when moving a shape outside a layout
         (cond-> (not (ctl/any-layout? parent))
           (pcb/update-shapes ids ctl/remove-layout-item-data))
@@ -353,7 +352,7 @@
 
         ;; Remove the swap slots if it is moving to a different component
         (pcb/update-shapes
-         child-heads
+         child-heads-ids
          (fn [shape]
            (cond-> shape
              (not= component-main-parent (ctn/find-component-main objects shape false))
@@ -365,7 +364,86 @@
 
         ;; Add component-root property when moving a component outside a component
         (cond-> (not (ctn/get-instance-root objects parent))
-          (pcb/update-shapes child-heads #(assoc % :component-root true)))
+          (pcb/update-shapes child-heads-ids #(assoc % :component-root true)))
+
+        ;; Remove variant info and rename when moving outside a variant-container
+        (cond-> (not (ctk/is-variant-container? parent))
+          ((fn [changes]
+             (reduce
+              (fn [changes shape]
+                (let [new-name (str/replace (:variant-name shape) #", " " / ")
+                      [cpath cname] (cfh/parse-path-name new-name)]
+                  (-> changes
+                      (pcb/update-component (:component-id shape)
+                                            #(-> (dissoc % :variant-id :variant-properties)
+                                                 (assoc :name cname
+                                                        :path cpath))
+                                            {:apply-changes-local-library? true})
+                      (pcb/update-shapes [(:id shape)]
+                                         #(-> (dissoc % :variant-id :variant-name)
+                                              (assoc :name new-name))))))
+              changes
+              variant-heads))))
+
+        ;; Add variant info and rename when moving into a different variant-container
+        (cond-> (ctk/is-variant-container? parent)
+          ((fn [changes]
+             (let [get-base-name      #(if (some? (:variant-name %))
+                                         (str/replace (:variant-name %) #", " " / ")
+                                         (:name %))
+
+                   calc-num-props     #(-> %
+                                           get-base-name
+                                           cfh/split-path
+                                           count)
+
+                   max-path-items     (apply max (map calc-num-props child-heads))
+
+                   first-comp-id      (->> parent
+                                           :shapes
+                                           first
+                                           (get objects)
+                                           :component-id)
+
+                   data               (pcb/get-library-data changes)
+                   variant-properties (get-in data [:components first-comp-id :variant-properties])
+                   num-props          (count variant-properties)
+                   num-new-props      (if (< max-path-items num-props)
+                                        0
+                                        (- max-path-items num-props))
+
+                   changes            (nth
+                                       (iterate #(clv/generate-add-new-property % (:id parent)) changes)
+                                       num-new-props)]
+               (reduce
+                (fn [changes shape]
+                  (if (= (:id parent) (:variant-id shape))
+                    changes ;; do nothing if we aren't changing the parent
+                    (let [base-name           (get-base-name shape)
+
+                          ;; we need to get the updated library data to have access to the current properties
+                          data                (pcb/get-library-data changes)
+
+                          props               (clv/path-to-properties
+                                               base-name
+                                               (get-in data [:components first-comp-id :variant-properties]))
+
+                          variant-name        (clv/properties-to-name props)
+                          [cpath cname]       (cfh/parse-path-name (:name parent))]
+
+                      (-> (pcb/update-component changes
+                                                (:component-id shape)
+                                                #(assoc % :variant-id (:id parent)
+                                                        :variant-properties props
+                                                        :name cname
+                                                        :path cpath)
+                                                {:apply-changes-local-library? true})
+                          (pcb/update-shapes [(:id shape)]
+                                             #(assoc % :variant-id (:id parent)
+                                                     :variant-name variant-name
+                                                     :name (:name parent)))))))
+                changes
+                child-heads)))))
 
         ;; Move the shapes
         (pcb/change-parent parent-id

common/src/app/common/logic/tokens.cljc

@@ -1,31 +1,38 @@
+;; 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.logic.tokens
   (:require
    [app.common.files.changes-builder :as pcb]
    [app.common.types.tokens-lib :as ctob]))
 
 (defn generate-update-active-sets
-  "Copy the active sets from the currently active themes and move them to the hidden token theme and update the theme with `update-hidden-theme-fn`.
+  "Copy the active sets from the currently active themes and move them
+  to the hidden token theme and update the theme with
+  `update-theme-fn`.
 
-  Use this for managing sets active state without having to modify a user created theme (\"no themes selected\" state in the ui)."
-  [changes tokens-lib update-hidden-theme-fn]
+  Use this for managing sets active state without having to modify a
+  user created theme (\"no themes selected\" state in the ui)."
+  [changes tokens-lib update-theme-fn]
   (let [prev-active-token-themes (ctob/get-active-theme-paths tokens-lib)
         active-token-set-names   (ctob/get-active-themes-set-names tokens-lib)
 
-        prev-hidden-token-theme (ctob/get-hidden-theme tokens-lib)
-        hidden-token-theme      (-> (or (some-> prev-hidden-token-theme (ctob/set-sets active-token-set-names))
-                                        (ctob/make-hidden-token-theme :sets active-token-set-names))
-                                    (update-hidden-theme-fn))
+        prev-hidden-token-theme  (ctob/get-hidden-theme tokens-lib)
 
-        changes (-> changes
-                    (pcb/update-active-token-themes #{ctob/hidden-token-theme-path} prev-active-token-themes))
-
-        changes (if prev-hidden-token-theme
-                  (pcb/update-token-theme changes hidden-token-theme prev-hidden-token-theme)
-                  (pcb/add-token-theme changes hidden-token-theme))]
-    changes))
+        hidden-token-theme       (-> (some-> prev-hidden-token-theme (ctob/set-sets active-token-set-names))
+                                     (update-theme-fn))]
+    (-> changes
+        (pcb/update-active-token-themes #{ctob/hidden-token-theme-path} prev-active-token-themes)
+        (pcb/set-token-theme (:group prev-hidden-token-theme)
+                             (:name prev-hidden-token-theme)
+                             hidden-token-theme))))
 
 (defn generate-toggle-token-set
-  "Toggle a token set at `set-name` in `tokens-lib` without modifying a user theme."
+  "Toggle a token set at `set-name` in `tokens-lib` without modifying a
+  user theme."
   [changes tokens-lib set-name]
   (generate-update-active-sets changes tokens-lib #(ctob/toggle-set % set-name)))
 
@@ -48,17 +55,19 @@
 (defn vec-starts-with? [v1 v2]
   (= (subvec v1 0 (min (count v1) (count v2))) v2))
 
-(defn calculate-move-token-set-or-set-group
+(defn- calculate-move-token-set-or-set-group
   [tokens-lib {:keys [from-index to-index position collapsed-paths]
                :or {collapsed-paths #{}}}]
   (let [tree (-> (ctob/get-set-tree tokens-lib)
-                 (ctob/walk-sets-tree-seq :walk-children? #(contains? collapsed-paths %)))
+                 (ctob/walk-sets-tree-seq :skip-children-pred #(contains? collapsed-paths %)))
+
         from (nth tree from-index)
         to (nth tree to-index)
         before (case position
                  :top to
                  :bot (nth tree (inc to-index) nil)
                  :center nil)
+
         prev-before (if (:group? from)
                       (->> (drop (inc from-index) tree)
                            (filter (fn [element]
@@ -72,6 +81,7 @@
                                       (= :bot position)
                                       (:group? to)
                                       (not (get collapsed-paths (:path to)))))
+
         from-path (:path from)
         to-parent-path (if drop-as-direct-group-child?
                          (:path to)
@@ -117,15 +127,15 @@
 (defn generate-move-token-set
   "Create changes for dropping a token set or token set.
   Throws for impossible moves."
-  [changes tokens-lib drop-opts]
-  (if-let [drop-opts' (calculate-move-token-set-or-set-group tokens-lib drop-opts)]
-    (pcb/move-token-set-before changes drop-opts')
+  [changes tokens-lib params]
+  (if-let [params (calculate-move-token-set-or-set-group tokens-lib params)]
+    (pcb/move-token-set changes params)
     changes))
 
 (defn generate-move-token-set-group
   "Create changes for dropping a token set or token set group.
   Throws for impossible moves"
-  [changes tokens-lib drop-opts]
-  (if-let [drop-opts' (calculate-move-token-set-or-set-group tokens-lib drop-opts)]
-    (pcb/move-token-set-group-before changes drop-opts')
+  [changes tokens-lib params]
+  (if-let [params (calculate-move-token-set-or-set-group tokens-lib params)]
+    (pcb/move-token-set-group changes params)
     changes))

common/src/app/common/logic/variants.cljc

@@ -0,0 +1,160 @@
+;; 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.logic.variants
+  (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.files.changes-builder :as pcb]
+   [app.common.files.helpers :as cfh]
+   [app.common.types.components-list :as ctcl]
+   [cuerdas.core :as str]))
+
+
+
+(def property-prefix "Property")
+(def property-regex (re-pattern (str property-prefix "(\\d+)")))
+(def value-prefix "Value")
+
+(defn find-related-components
+  "Find a list of the components thet belongs to this variant-id"
+  [data objects variant-id]
+  (->> (dm/get-in objects [variant-id :shapes])
+       (map #(dm/get-in objects [% :component-id]))
+       (map #(ctcl/get-component data % true))
+       reverse))
+
+
+(defn properties-to-name
+  "Transform the properties into a name, with the values separated by comma"
+  [properties]
+  (->> properties
+       (map :value)
+       (remove str/empty?)
+       (str/join ", ")))
+
+
+(defn next-property-number
+  "Returns the next property number, to avoid duplicates on the property names"
+  [properties]
+  (let [numbers (keep
+                 #(some->> (:name %) (re-find property-regex) second d/parse-integer)
+                 properties)
+        max-num (if (seq numbers)
+                  (apply max numbers)
+                  0)]
+    (inc (max max-num (count properties)))))
+
+
+(defn path-to-properties
+  "From a list of properties and a name with path, assign each token of the
+   path as value of a different property"
+  [path properties]
+  (let [next-prop-num  (next-property-number properties)
+        cpath          (cfh/split-path path)
+        assigned       (mapv #(assoc % :value (nth cpath %2 "")) properties (range))
+        remaining      (drop (count properties) cpath)
+        new-properties (map-indexed (fn [i v] {:name (str property-prefix (+ next-prop-num i))
+                                               :value v}) remaining)]
+    (into assigned new-properties)))
+
+(defn- dashes-to-end
+  [property-values]
+  (let [dashes (if (some #(= % "--") property-values) ["--"] [])]
+    (concat (remove #(= % "--") property-values) dashes)))
+
+
+(defn extract-properties-values
+  [data objects variant-id]
+  (->> (find-related-components data objects variant-id)
+       (mapcat :variant-properties)
+       (group-by :name)
+       (map (fn [[k v]]
+              {:name k
+               :value (->> v
+                           (map #(if (str/empty? (:value %)) "--" (:value %)))
+                           distinct
+                           dashes-to-end)}))))
+
+
+(defn generate-update-property-name
+  [changes variant-id pos new-name]
+  (let [data               (pcb/get-library-data changes)
+        objects            (pcb/get-objects changes)
+        related-components (find-related-components data objects variant-id)]
+    (reduce (fn [changes component]
+              (pcb/update-component
+               changes (:id component)
+               #(assoc-in % [:variant-properties pos :name] new-name)
+               {:apply-changes-local-library? true}))
+            changes
+            related-components)))
+
+
+(defn generate-remove-property
+  [changes variant-id pos]
+  (let [data               (pcb/get-library-data changes)
+        objects            (pcb/get-objects changes)
+        related-components (find-related-components data objects variant-id)]
+    (reduce (fn [changes component]
+              (let [props   (:variant-properties component)
+                    props   (d/remove-at-index props pos)
+                    main-id (:main-instance-id component)
+                    name    (properties-to-name props)]
+                (-> changes
+                    (pcb/update-component (:id component) #(assoc % :variant-properties props)
+                                          {:apply-changes-local-library? true})
+                    (pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
+            changes
+            related-components)))
+
+
+(defn generate-update-property-value
+  [changes component-id pos value]
+  (let [data      (pcb/get-library-data changes)
+        component (ctcl/get-component data component-id true)
+        main-id   (:main-instance-id component)
+        name      (-> (:variant-properties component)
+                      (update pos assoc :value value)
+                      properties-to-name)]
+    (-> changes
+        (pcb/update-component component-id #(assoc-in % [:variant-properties pos :value] value)
+                              {:apply-changes-local-library? true})
+        (pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
+
+
+(defn generate-add-new-property
+  [changes variant-id & {:keys [fill-values?]}]
+  (let [data               (pcb/get-library-data changes)
+        objects            (pcb/get-objects changes)
+        related-components (find-related-components data objects variant-id)
+
+        props              (-> related-components first :variant-properties)
+        next-prop-num      (next-property-number props)
+        property-name      (str property-prefix next-prop-num)
+
+        [_ changes]
+        (reduce (fn [[num changes] component]
+                  (let [main-id      (:main-instance-id component)
+
+                        update-props #(-> (d/nilv % [])
+                                          (conj {:name property-name
+                                                 :value (if fill-values? (str value-prefix num) "")}))
+
+                        update-name #(if fill-values?
+                                       (if (str/empty? %)
+                                         (str value-prefix num)
+                                         (str % ", " value-prefix num))
+                                       %)]
+                    [(inc num)
+                     (-> changes
+                         (pcb/update-component (:id component)
+                                               #(update % :variant-properties update-props)
+                                               {:apply-changes-local-library? true})
+                         (pcb/update-shapes [main-id] #(update % :variant-name update-name)))]))
+                [1 changes]
+                related-components)]
+    changes))
+

common/src/app/common/schema.cljc

@@ -390,14 +390,22 @@
 (register! :merge (mu/-merge))
 (register! :union (mu/-union))
 
-(def uuid-rx
-  #"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$")
-
-(defn parse-uuid
+(defn- parse-uuid
   [s]
-  (if (string? s)
-    (some->> (re-matches uuid-rx s) uuid/uuid)
-    s))
+  (if (uuid? s)
+    s
+    (if (str/empty? s)
+      nil
+      (try
+        (uuid/parse s)
+        (catch #?(:clj Exception :cljs :default) _cause
+          s)))))
+
+(defn- encode-uuid
+  [v]
+  (if (uuid? v)
+    (str v)
+    v))
 
 (register!
  {:type ::uuid
@@ -409,8 +417,8 @@
    :gen/gen (sg/uuid)
    :decode/string parse-uuid
    :decode/json parse-uuid
-   :encode/string str
-   :encode/json str
+   :encode/string encode-uuid
+   :encode/json encode-uuid
    ::oapi/type "string"
    ::oapi/format "uuid"}})
 
@@ -856,7 +864,7 @@
                                     choices))]
                {:pred pred
                 :type-properties
-                {:title "contains"
+                {:title "contains any"
                  :description "contains predicate"}}))})
 
 (register!
@@ -1019,26 +1027,26 @@
 (def valid-text?
   (validator ::text))
 
-(def check-safe-int!
+(def check-safe-int
   (check-fn ::safe-int))
 
-(def check-set-of-strings!
+(def check-set-of-strings
   (check-fn ::set-of-strings))
 
-(def check-email!
+(def check-email
   (check-fn ::email))
 
-(def check-uuid!
+(def check-uuid
   (check-fn ::uuid :hint "expected valid uuid instance"))
 
-(def check-string!
+(def check-string
   (check-fn :string :hint "expected string"))
 
-(def check-coll-of-uuid!
+(def check-coll-of-uuid
   (check-fn ::coll-of-uuid))
 
-(def check-set-of-uuid!
+(def check-set-of-uuid
   (check-fn ::set-of-uuid))
 
-(def check-set-of-emails!
+(def check-set-of-emails
   (check-fn [::set ::email]))

common/src/app/common/schema/test.cljc

@@ -60,6 +60,7 @@
   (let [smallest (-> params :shrunk :smallest vec)]
     (println)
     (println "Condition failed with the following params:")
+    (println "Seed:" (:seed params))
     (println)
     (pp/pprint smallest)))
 

common/src/app/common/test_helpers/components.cljc

@@ -57,6 +57,14 @@
                                         :main-instance-page (:id page)
                                         :shapes updated-shapes))))))))
 
+(defn update-component
+  [file component-label & {:keys [] :as params}]
+  (let [component-id  (thi/id component-label)]
+    (ctf/update-file-data
+     file
+     (fn [file-data]
+       (ctkl/update-component file-data component-id #(merge % params))))))
+
 (defn get-component
   [file label & {:keys [include-deleted?] :or {include-deleted? false}}]
   (ctkl/get-component (:data file) (thi/id label) include-deleted?))

common/src/app/common/test_helpers/tokens.cljc

@@ -35,6 +35,11 @@
           (ctob/get-set set-name)
           (ctob/get-token token-name)))))
 
+(defn token-data-eq?
+  "Compare token data without comparing modified timestamp"
+  [t1 t2]
+  (= (dissoc t1 :modified-at) (dissoc t2 :modified-at)))
+
 (defn- set-stroke-width
   [shape stroke-width]
   (let [strokes (if (seq (:strokes shape))

common/src/app/common/test_helpers/variants.cljc

@@ -0,0 +1,25 @@
+;; 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.test-helpers.variants
+  (:require
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.ids-map :as thi]
+   [app.common.test-helpers.shapes :as ths]))
+
+(defn add-variant
+  [file variant-label component1-label root1-label component2-label root2-label
+   & {:keys []}]
+  (let [file (ths/add-sample-shape file variant-label :type :frame :is-variant-container true)
+        variant-id (thi/id variant-label)]
+
+    (-> file
+        (ths/add-sample-shape root2-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "Value2")
+        (ths/add-sample-shape root1-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "Value1")
+        (thc/make-component component1-label root1-label)
+        (thc/update-component component1-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]})
+        (thc/make-component component2-label root2-label)
+        (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]}))))

common/src/app/common/types/color.cljc

@@ -118,10 +118,10 @@
 (def valid-color?
   (sm/lazy-validator schema:color))
 
-(def check-color!
+(def check-color
   (sm/check-fn schema:color :hint "expected valid color struct"))
 
-(def check-recent-color!
+(def check-recent-color
   (sm/check-fn schema:recent-color))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/types/component.cljc

@@ -215,6 +215,19 @@
   (and (= shape-id (:main-instance-id component))
        (= page-id (:main-instance-page component))))
 
+
+(defn is-variant?
+  "Check if this shape or component is a variant component"
+  [item]
+  (some? (:variant-id item)))
+
+
+(defn is-variant-container?
+  "Check if this shape is a variant container"
+  [shape]
+  (:is-variant-container shape))
+
+
 (defn set-touched-group
   [touched group]
   (when group
@@ -320,6 +333,8 @@
   (let [parent (get objects (:parent-id shape))]
     ;; We don't want to change the structure of component copies
     (and (not (in-component-copy-not-head? shape))
+         ;; We don't want to duplicate variants
+         (not (is-variant? shape))
          ;; Non instance, non copy. We allow
          (or (not (instance-head? shape))
              (not (in-component-copy? parent))))))

common/src/app/common/types/components_list.cljc

@@ -34,12 +34,14 @@
   (assoc component :modified-at (dt/now)))
 
 (defn add-component
-  [fdata {:keys [id name path main-instance-id main-instance-page shapes annotation]}]
+  [fdata {:keys [id name path main-instance-id main-instance-page shapes annotation variant-id variant-properties]}]
   (let [components-v2  (dm/get-in fdata [:options :components-v2])
         fdata          (update fdata :components assoc id (touch {:id id :name name :path path}))]
     (if components-v2
       (cond-> (update-in fdata [:components id] assoc :main-instance-id main-instance-id :main-instance-page main-instance-page)
-        annotation (update-in [:components id] assoc :annotation annotation))
+        annotation (update-in [:components id] assoc :annotation annotation)
+        variant-id (update-in [:components id] assoc :variant-id variant-id)
+        variant-properties (update-in [:components id] assoc :variant-properties variant-properties))
 
       (let [wrap-object-fn cfeat/*wrap-with-objects-map-fn*]
         (assoc-in fdata [:components id :objects]
@@ -48,7 +50,7 @@
                        (wrap-object-fn)))))))
 
 (defn mod-component
-  [file-data {:keys [id name path main-instance-id main-instance-page objects annotation modified-at]}]
+  [file-data {:keys [id name path main-instance-id main-instance-page objects annotation variant-id variant-properties modified-at]}]
   (let [wrap-objects-fn cfeat/*wrap-with-objects-map-fn*]
     (d/update-in-when file-data [:components id]
                       (fn [component]
@@ -76,10 +78,22 @@
                                          (assoc :annotation annotation)
 
                                          (nil? annotation)
-                                         (dissoc :annotation))
+                                         (dissoc :annotation)
+
+                                         (some? variant-id)
+                                         (assoc :variant-id variant-id)
+
+                                         (nil? variant-id)
+                                         (dissoc :variant-id)
+
+                                         (some? variant-properties)
+                                         (assoc :variant-properties variant-properties)
+
+                                         (nil? variant-properties)
+                                         (dissoc :variant-properties))
                               diff     (set/difference
                                         (ctk/diff-components component new-comp)
-                                        #{:annotation :modified-at})] ;; The set of properties that doesn't mark a component as touched
+                                        #{:annotation :modified-at :variant-id :variant-properties})] ;; The set of properties that doesn't mark a component as touched
 
                           (if (empty? diff)
                             new-comp

common/src/app/common/types/container.cljc

@@ -406,7 +406,7 @@
              (cond-> new-shape
                :always
                (-> (gsh/move delta)
-                   (dissoc :touched))
+                   (dissoc :touched :variant-id :variant-name))
 
                (and main-instance? root?)
                (assoc :main-instance true)
@@ -501,7 +501,12 @@
 (defn- invalid-structure-for-component?
   "Check if the structure generated nesting children in parent is invalid in terms of nested components"
   [objects parent children pasting? libraries]
-  (let [; When we are pasting, the main shapes will be pasted as copies, unless the
+  (let [; If the original shapes had been cutted, and we are pasting them now, they aren't
+        ; in objects. We can add them to locate later
+        objects (merge objects
+                       (into {} (map (juxt :id identity) children)))
+
+        ; When we are pasting, the main shapes will be pasted as copies, unless the
         ; original component doesn't exist or is deleted. So for this function purposes, they
         ; are removed from the list
         remove? (fn [shape]
@@ -535,11 +540,26 @@
    (letfn [(get-frame [parent-id]
              (if (cfh/frame-shape? objects parent-id) parent-id (get-in objects [parent-id :frame-id])))]
      (let [parent (get objects parent-id)
-          ;; We can always move the children to the parent they already have.
+           ;; We can always move the children to the parent they already have.
+           ;; But if we are pasting, those are new items, so it is considered a change
            no-changes?
-           (->> children (every? #(= parent-id (:parent-id %))))]
-       ;; In case no-changes is true we must ensure we are copy pasting the children in the same position
-       (if (or (and no-changes? (not pasting?)) (not (invalid-structure-for-component? objects parent children pasting? libraries)))
+           (and (every? #(= parent-id (:parent-id %)) children)
+                (not pasting?))
+           all-main?
+           (every? ctk/main-instance? children)
+
+           any-main-descendant
+           (some
+            (fn [shape]
+              (some ctk/main-instance? (cfh/get-children-with-self objects (:id shape))))
+            children)]
+
+       (if (or no-changes?
+               (and (not (invalid-structure-for-component? objects parent children pasting? libraries))
+                    ;; If we are moving into a variant-container, all the items should be main
+                    (or all-main? (not (ctk/is-variant-container? parent)))
+                    ;; If we are moving into a main component, no descendant can be main
+                    (or (nil? any-main-descendant) (not (ctk/main-instance? parent)))))
          [parent-id (get-frame parent-id)]
          (recur (:parent-id parent) objects children pasting? libraries))))))
 

common/src/app/common/types/shape.cljc

@@ -148,7 +148,7 @@
 
 (sm/register! ::stroke schema:stroke)
 
-(def check-stroke!
+(def check-stroke
   (sm/check-fn schema:stroke))
 
 (def schema:shape-base-attrs
@@ -211,7 +211,7 @@
    [:interactions {:optional true}
     [:vector {:gen/max 2} ::ctsi/interaction]]
    [:shadow {:optional true}
-    [:vector {:gen/max 1} ::ctss/shadow]]
+    [:vector {:gen/max 1} ctss/schema:shadow]]
    [:blur {:optional true} ::ctsb/blur]
    [:grow-type {:optional true}
     [::sm/one-of grow-types]]

common/src/app/common/types/shape/interactions.cljc

@@ -7,7 +7,6 @@
 (ns app.common.types.shape.interactions
   (:require
    [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.bounds :as gsb]
@@ -110,13 +109,27 @@
 (def check-animation!
   (sm/check-fn schema:animation))
 
+(def schema:interaction-attrs
+  [:map {:title "InteractionAttrs"}
+   [:action-type {:optional true} [::sm/one-of action-types]]
+   [:event-type {:optional true} [::sm/one-of event-types]]
+   [:destination {:optional true} [:maybe ::sm/uuid]]
+   [:preserve-scroll {:optional true} :boolean]
+   [:animation {:optional true} schema:animation]
+   [:overlay-position {:optional true} ::gpt/point]
+   [:overlay-pos-type {:optional true} [::sm/one-of overlay-positioning-types]]
+   [:close-click-outside {:optional true} :boolean]
+   [:background-overlay {:optional true} :boolean]
+   [:position-relative-to {:optional true} [:maybe ::sm/uuid]]
+   [:url {:optional true} :string]])
+
 (def schema:navigate-interaction
   [:map
    [:action-type [:= :navigate]]
    [:event-type [::sm/one-of event-types]]
    [:destination {:optional true} [:maybe ::sm/uuid]]
    [:preserve-scroll {:optional true} :boolean]
-   [:animation {:optional true} ::animation]])
+   [:animation {:optional true} schema:animation]])
 
 (def schema:open-overlay-interaction
   [:map
@@ -127,7 +140,7 @@
    [:destination {:optional true} [:maybe ::sm/uuid]]
    [:close-click-outside {:optional true} :boolean]
    [:background-overlay {:optional true} :boolean]
-   [:animation {:optional true} ::animation]
+   [:animation {:optional true} schema:animation]
    [:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
 
 (def schema:toggle-overlay-interaction
@@ -139,7 +152,7 @@
    [:destination {:optional true} [:maybe ::sm/uuid]]
    [:close-click-outside {:optional true} :boolean]
    [:background-overlay {:optional true} :boolean]
-   [:animation {:optional true} ::animation]
+   [:animation {:optional true} schema:animation]
    [:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
 
 (def schema:close-overlay-interaction
@@ -147,7 +160,7 @@
    [:action-type [:= :close-overlay]]
    [:event-type [::sm/one-of event-types]]
    [:destination {:optional true} [:maybe ::sm/uuid]]
-   [:animation {:optional true} ::animation]
+   [:animation {:optional true} schema:animation]
    [:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
 
 (def schema:prev-scren-interaction
@@ -162,25 +175,25 @@
    [:url :string]])
 
 (def schema:interaction
-  [:multi {:dispatch :action-type
-           :title "Interaction"
-           :gen/gen (sg/one-of (sg/generator schema:navigate-interaction)
-                               (sg/generator schema:open-overlay-interaction)
-                               (sg/generator schema:close-overlay-interaction)
-                               (sg/generator schema:toggle-overlay-interaction)
-                               (sg/generator schema:prev-scren-interaction)
-                               (sg/generator schema:open-url-interaction))
-           :decode/json #(update % :action-type keyword)}
-   [:navigate schema:navigate-interaction]
-   [:open-overlay schema:open-overlay-interaction]
-   [:toggle-overlay schema:toggle-overlay-interaction]
-   [:close-overlay schema:close-overlay-interaction]
-   [:prev-screen schema:prev-scren-interaction]
-   [:open-url schema:open-url-interaction]])
+  [:and {:title "Interaction"
+         :gen/gen (sg/one-of (sg/generator schema:navigate-interaction)
+                             (sg/generator schema:open-overlay-interaction)
+                             (sg/generator schema:close-overlay-interaction)
+                             (sg/generator schema:toggle-overlay-interaction)
+                             (sg/generator schema:prev-scren-interaction)
+                             (sg/generator schema:open-url-interaction))}
+   schema:interaction-attrs
+   [:multi {:dispatch :action-type}
+    [:navigate schema:navigate-interaction]
+    [:open-overlay schema:open-overlay-interaction]
+    [:toggle-overlay schema:toggle-overlay-interaction]
+    [:close-overlay schema:close-overlay-interaction]
+    [:prev-screen schema:prev-scren-interaction]
+    [:open-url schema:open-url-interaction]]])
 
 (sm/register! ::interaction schema:interaction)
 
-(def check-interaction!
+(def check-interaction
   (sm/check-fn schema:interaction))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -203,18 +216,13 @@
 
 (defn set-event-type
   [interaction event-type shape]
-  (dm/assert!
-   "Should be an interraction map"
-   (check-interaction! interaction))
+  (assert (check-interaction interaction))
+  (assert (contains? event-types event-type)
+          "should be a valid event type")
 
-  (dm/assert!
-   "Should be a valid event type"
-   (contains? event-types event-type))
-
-  (dm/assert!
-   "The `:after-delay` event type incompatible with not frame shapes"
-   (or (not= event-type :after-delay)
-       (cfh/frame-shape? shape)))
+  (assert (or (not= event-type :after-delay)
+              (cfh/frame-shape? shape))
+          "the `:after-delay` event type incompatible with not frame shapes")
 
   (if (= (:event-type interaction) event-type)
     interaction
@@ -230,14 +238,9 @@
 
 (defn set-action-type
   [interaction action-type]
-
-  (dm/assert!
-   "Should be an interraction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "Should be a valid event type"
-   (contains? action-types action-type))
+  (assert (check-interaction interaction))
+  (assert (contains? action-types action-type)
+          "Should be a valid event type")
 
   (let [new-interaction
         (if (= (:action-type interaction) action-type)
@@ -284,18 +287,10 @@
 
 (defn set-delay
   [interaction delay]
-
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid delay"
-   (sm/check-safe-int! delay))
-
-  (dm/assert!
-   "expected compatible interaction event type"
-   (has-delay interaction))
+  (assert (check-interaction interaction))
+  (assert (sm/check-safe-int delay))
+  (assert (has-delay interaction)
+          "expected compatible interaction event type")
 
   (assoc interaction :delay delay))
 
@@ -315,14 +310,9 @@
 
 (defn set-destination
   [interaction destination]
-
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected compatible interaction event type"
-   (has-destination interaction))
+  (assert (check-interaction interaction))
+  (assert (has-destination interaction)
+          "expected compatible interaction event type")
 
   (cond-> interaction
     :always
@@ -340,17 +330,11 @@
 (defn set-preserve-scroll
   [interaction preserve-scroll]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected boolean for `preserve-scroll`"
-   (boolean? preserve-scroll))
-
-  (dm/assert!
-   "expected compatible interaction map with preserve-scroll"
-   (has-preserve-scroll interaction))
+  (assert (check-interaction interaction))
+  (assert (boolean? preserve-scroll)
+          "expected boolean for `preserve-scroll`")
+  (assert (has-preserve-scroll interaction)
+          "expected compatible interaction map with preserve-scroll")
 
   (assoc interaction :preserve-scroll preserve-scroll))
 
@@ -361,17 +345,11 @@
 (defn set-url
   [interaction url]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected a string for `url`"
-   (string? url))
-
-  (dm/assert!
-   "expected compatible interaction map with url param"
-   (has-url interaction))
+  (assert (check-interaction interaction))
+  (assert (string? url)
+          "expected a string for `url`")
+  (assert (has-url interaction)
+          "expected compatible interaction map with url param")
 
   (assoc interaction :url url))
 
@@ -382,17 +360,12 @@
 (defn set-overlay-pos-type
   [interaction overlay-pos-type shape objects]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
+  (assert (check-interaction interaction))
 
-  (dm/assert!
-   "expected valid overlay positioning type"
-   (contains? overlay-positioning-types overlay-pos-type))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (contains? overlay-positioning-types overlay-pos-type)
+          "expected valid overlay positioning type")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (assoc interaction
          :overlay-pos-type overlay-pos-type
@@ -403,17 +376,11 @@
 (defn toggle-overlay-pos-type
   [interaction overlay-pos-type shape objects]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid overlay positioning type"
-   (contains? overlay-positioning-types overlay-pos-type))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (check-interaction interaction))
+  (assert (contains? overlay-positioning-types overlay-pos-type)
+          "expected valid overlay positioning type")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (let [new-pos-type (if (= (:overlay-pos-type interaction) overlay-pos-type)
                        :manual
@@ -427,17 +394,12 @@
 (defn set-overlay-position
   [interaction overlay-position]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
+  (assert (check-interaction interaction))
+  (assert (gpt/point? overlay-position)
+          "expected valid overlay position")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
-  (dm/assert!
-   "expected valid overlay position"
-   (gpt/point? overlay-position))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
 
   (assoc interaction
          :overlay-pos-type :manual
@@ -446,52 +408,34 @@
 (defn set-close-click-outside
   [interaction close-click-outside]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected boolean value for `close-click-outside`"
-   (boolean? close-click-outside))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (check-interaction interaction))
+  (assert (boolean? close-click-outside)
+          "expected boolean value for `close-click-outside`")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (assoc interaction :close-click-outside close-click-outside))
 
 (defn set-background-overlay
   [interaction background-overlay]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected boolean value for `background-overlay`"
-   (boolean? background-overlay))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (check-interaction interaction))
+  (assert (boolean? background-overlay)
+          "expected boolean value for `background-overlay`")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (assoc interaction :background-overlay background-overlay))
 
 (defn set-position-relative-to
   [interaction position-relative-to]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid uuid for `position-relative-to`"
-   (or (nil? position-relative-to)
-       (uuid? position-relative-to)))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (check-interaction interaction))
+  (assert (or (nil? position-relative-to)
+              (uuid? position-relative-to))
+          "expected valid uuid for `position-relative-to`")
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (assoc interaction :position-relative-to position-relative-to))
 
@@ -519,13 +463,9 @@
    frame-offset]       ;; if this interaction starts in a frame opened
                        ;; on another interaction, this is the position
                        ;; of that frame
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-overlay-opts interaction))
+  (assert (check-interaction interaction))
+  (assert (has-overlay-opts interaction)
+          "expected compatible interaction map")
 
   (let [;; When the interactive item is inside a nested frame we need to add to the offset the position
         ;; of the parent-frame otherwise the position won't match
@@ -617,22 +557,15 @@
 
 (defn set-animation-type
   [interaction animation-type]
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
 
-  (dm/assert!
-   "expected valid value for `animation-type`"
-   (or (nil? animation-type)
-       (contains? animation-types animation-type)))
-
-  (dm/assert!
-   "expected interaction map compatible with animation"
-   (has-animation? interaction))
-
-  (dm/assert!
-   "expected allowed animation type"
-   (allowed-animation? (:action-type interaction) animation-type))
+  (assert (check-interaction interaction))
+  (assert (or (nil? animation-type)
+              (contains? animation-types animation-type))
+          "expected valid value for `animation-type`")
+  (assert (has-animation? interaction)
+          "expected interaction map compatible with animation")
+  (assert (allowed-animation? (:action-type interaction) animation-type)
+          "expected allowed animation type")
 
   (if (= (-> interaction :animation :animation-type) animation-type)
     interaction
@@ -668,17 +601,10 @@
 (defn set-duration
   [interaction duration]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid duration"
-   (sm/check-safe-int! duration))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-duration? interaction))
+  (assert (check-interaction interaction))
+  (assert (sm/check-safe-int duration))
+  (assert (has-duration? interaction)
+          "expected compatible interaction map")
 
   (update interaction :animation assoc :duration duration))
 
@@ -689,17 +615,11 @@
 (defn set-easing
   [interaction easing]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid easing"
-   (contains? easing-types easing))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-easing? interaction))
+  (assert (check-interaction interaction))
+  (assert (contains? easing-types easing)
+          "expected valid easing")
+  (assert (has-easing? interaction)
+          "expected compatible interaction map")
 
   (update interaction :animation assoc :easing easing))
 
@@ -712,17 +632,11 @@
 (defn set-way
   [interaction way]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid way"
-   (contains? way-types way))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-way? interaction))
+  (assert (check-interaction interaction))
+  (assert (contains? way-types way)
+          "expected valid way")
+  (assert (has-way? interaction)
+          "expected compatible interaction map")
 
   (update interaction :animation assoc :way way))
 
@@ -733,26 +647,20 @@
 (defn set-direction
   [interaction direction]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
+  (assert (check-interaction interaction))
+  (assert (contains? direction-types direction)
+          "expected valid direction")
 
-  (dm/assert!
-   "expected valid direction"
-   (contains? direction-types direction))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-direction? interaction))
+  (assert (has-direction? interaction)
+          "expected compatible interaction map")
 
   (update interaction :animation assoc :direction direction))
 
 (defn invert-direction
   [animation]
-  (dm/assert!
-   "expected valid animation map"
-   (or (nil? animation)
-       (check-animation! animation)))
+  (assert (or (nil? animation)
+              (check-animation! animation))
+          "expected valid animation map")
 
   (case (:direction animation)
     :right
@@ -768,24 +676,18 @@
 
 (defn has-offset-effect?
   [interaction]
-  ; Offset-effect is ignored in slide animations of overlay actions
+  ;; Offset-effect is ignored in slide animations of overlay actions
   (and (= (:action-type interaction) :navigate)
        (= (-> interaction :animation :animation-type) :slide)))
 
 (defn set-offset-effect
   [interaction offset-effect]
 
-  (dm/assert!
-   "expected valid interaction map"
-   (check-interaction! interaction))
-
-  (dm/assert!
-   "expected valid boolean for `offset-effect`"
-   (boolean? offset-effect))
-
-  (dm/assert!
-   "expected compatible interaction map"
-   (has-offset-effect? interaction))
+  (assert (check-interaction interaction))
+  (assert (boolean? offset-effect)
+          "expected valid boolean for `offset-effect`")
+  (assert (has-offset-effect? interaction)
+          "expected compatible interaction map")
 
   (update interaction :animation assoc :offset-effect offset-effect))
 

common/src/app/common/types/shape/layout.cljc

@@ -1664,3 +1664,12 @@
                     (d/update-when id merge-cells (get target-cells id))))
               source-cells))))
     source-cells))
+
+(defn toggle-fix-if-auto
+  "Changes the sizing to fix if it's fill"
+  [shape]
+  (cond-> shape
+    (= (:layout-item-h-sizing shape) :fill)
+    (assoc :layout-item-h-sizing :fix)
+    (= (:layout-item-v-sizing shape) :fill)
+    (assoc :layout-item-v-sizing :fix)))

common/src/app/common/types/shape/shadow.cljc

@@ -26,7 +26,9 @@
    [:hidden :boolean]
    [:color ::ctc/color]])
 
-(sm/register! ::shadow schema:shadow)
-
-(def check-shadow!
+(def check-shadow
   (sm/check-fn schema:shadow))
+
+(def valid-shadow?
+  (sm/validator schema:shadow))
+

common/src/app/common/types/token.cljc

@@ -60,7 +60,7 @@
   (token-types t))
 
 (def token-name-ref
-  [:and :string [:re #"^(?!\$)([a-zA-Z0-9-$]+\.?)*(?<!\.)$"]])
+  [:and :string [:re #"^(?!\$)([a-zA-Z0-9-$_]+\.?)*(?<!\.)$"]])
 
 (defn valid-token-name-ref?
   [n]
@@ -129,6 +129,10 @@
   [:p2 {:optional true} token-name-ref]
   [:p3 {:optional true} token-name-ref]
   [:p4 {:optional true} token-name-ref]
+  [:m1 {:optional true} token-name-ref]
+  [:m2 {:optional true} token-name-ref]
+  [:m3 {:optional true} token-name-ref]
+  [:m4 {:optional true} token-name-ref]
   [:x {:optional true} token-name-ref]
   [:y {:optional true} token-name-ref]])
 
@@ -178,12 +182,27 @@
   ([shape-attr] (shape-attr->token-attrs shape-attr nil))
   ([shape-attr changed-sub-attr]
    (cond
-     (= :fills shape-attr) #{:fill}
-     (and (= :strokes shape-attr) (nil? changed-sub-attr)) #{:stroke-width :stroke-color}
+     (= :fills shape-attr)
+     #{:fill}
+
+     (and (= :strokes shape-attr) (nil? changed-sub-attr))
+     #{:stroke-width :stroke-color}
+
      (= :strokes shape-attr)
      (cond
        (some #{:stroke-color} changed-sub-attr) #{:stroke-color}
        (some #{:stroke-width} changed-sub-attr) #{:stroke-width})
+
+     (= :layout-padding shape-attr)
+     (if (seq changed-sub-attr)
+       changed-sub-attr
+       #{:p1 :p2 :p3 :p4})
+
+     (= :layout-item-margin shape-attr)
+     (if (seq changed-sub-attr)
+       changed-sub-attr
+       #{:m1 :m2 :m3 :m4})
+
      (border-radius-keys shape-attr) #{shape-attr}
      (sizing-keys shape-attr) #{shape-attr}
      (opacity-keys shape-attr) #{shape-attr}

common/src/app/common/types/token_theme.cljc

@@ -15,6 +15,7 @@
   [:group :string]
   [:description [:maybe :string]]
   [:is-source :boolean]
+  [:id :string]
   [:modified-at {:optional true} ::sm/inst]
   [:sets :any]])
 
@@ -24,4 +25,4 @@
   [:name :string]
   [:description {:optional true} [:maybe :string]]
   [:modified-at {:optional true} ::sm/inst]
-  [:tokens :any]])
+  [:tokens {:optional true} :any]])

common/src/app/common/uuid.cljc

@@ -17,9 +17,14 @@
            java.util.UUID
            java.nio.ByteBuffer)))
 
+(def regex
+  #"^[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]-[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]-[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]-[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]-[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]$")
+
 (defn uuid
   "Creates an UUID instance from string, expectes valid uuid strings,
-  the existense of validation is implementation detail"
+  the existense of validation is implementation detail.
+
+  UNSAFE: this can accept invalid uuids or incomplete uuids"
   [s]
   #?(:clj (UUID/fromString s)
      :cljs (c/uuid s)))
@@ -27,8 +32,21 @@
 (defn parse
   "Parse string uuid representation into proper UUID instance, validates input"
   [s]
-  #?(:clj (UUID/fromString s)
-     :cljs (c/parse-uuid s)))
+  (if (and (string? s) ^boolean (re-matches regex s))
+    #?(:clj (UUID/fromString s)
+       :cljs (uuid s))
+
+    (let [message (str "invalid string '" s "' for uuid")]
+      (throw #?(:clj  (IllegalArgumentException. message)
+                :cljs (js/Error. message))))))
+
+(defn parse*
+  "Exception safe version of `parse`."
+  [s]
+  (try
+    (parse s)
+    (catch #?(:clj Exception :cljs :default) _cause
+      nil)))
 
 (defn next
   []
@@ -95,6 +113,11 @@
      (impl/getUnsignedParts (.-uuid ^UUID this))))
 
 
+#?(:cljs
+   (defn from-unsigned-parts
+     [a b c d]
+     (uuid (impl/fromUnsignedParts a b c d))))
+
 #?(:cljs
    (defn get-u32
      "A cached variant of get-unsigned-parts"

common/test/common_tests/colors_test.cljc

@@ -51,9 +51,13 @@
   (t/is (= [0 0 0] (colors/hex->rgb "#kkk")))
   (t/is (= [1 2 3] (colors/hex->rgb "#010203"))))
 
-#?(:cljs
-   (t/deftest format-hsla
-     (t/is (= "210, 50%, 1%, 1" (colors/format-hsla [210.0 0.5 0.00784313725490196 1])))))
+(t/deftest format-hsla
+  (t/is (= "210, 50%, 0.78%, 1" (colors/format-hsla [210.0 0.5 0.00784313725490196 1])))
+  (t/is (= "220, 5%, 30%, 0.8" (colors/format-hsla [220.0 0.05 0.3 0.8]))))
+
+(t/deftest format-rgba
+  (t/is (= "210, 199, 12, 0.08" (colors/format-rgba [210 199 12 0.08])))
+  (t/is (= "210, 199, 12, 1" (colors/format-rgba [210 199 12 1]))))
 
 (t/deftest rgb-to-hsl
   (t/is (= [210.0 0.5 0.00784313725490196] (colors/rgb->hsl [1 2 3])))

common/test/common_tests/files/helpers_test.cljc

@@ -0,0 +1,38 @@
+;; 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 common-tests.files.helpers-test
+  (:require
+   [app.common.files.helpers :as cfh]
+   [clojure.test :as t]))
+
+(t/deftest test-generate-unique-name
+  (t/testing "Test unique name generation"
+    (let [suffix-fn #(str "-copy-" %)]
+      (t/is (cfh/generate-unique-name "base-name"
+                                      #{"base-name" "base-name-copy-1"}
+                                      :suffix-fn suffix-fn)
+            "base-name-copy-2")
+      (t/is (cfh/generate-unique-name "base-name"
+                                      #{"base-name-copy-2"}
+                                      :suffix-fn suffix-fn)
+            "base-name-copy-1")
+      (t/is (cfh/generate-unique-name "base-name"
+                                      #{"base-namec-copy"}
+                                      :suffix-fn suffix-fn)
+            "base-name-copy-1")
+      (t/is (cfh/generate-unique-name "base-name"
+                                      #{"base-name"}
+                                      :suffix-fn suffix-fn)
+            "base-name-copy-1")))
+
+  (t/testing "Test unique name generation with immidate suffix and default suffix-fn"
+    (t/is (cfh/generate-unique-name "base-name" #{} :immediate-suffix? true)
+          "base-name 1")
+    (t/is (cfh/generate-unique-name "base-name"
+                                    #{"base-name 1" "base-name 2"}
+                                    :immediate-suffix? true)
+          "base-name 3")))

common/test/common_tests/logic/comp_creation_test.cljc

@@ -20,6 +20,7 @@
    [app.common.types.component :as ctk]
    [app.common.types.components-list :as ctkl]
    [app.common.types.shape-tree :as ctst]
+   [app.common.uuid :as uuid]
    [clojure.test :as t]))
 
 (t/use-fixtures :each thi/test-fixture)
@@ -285,10 +286,12 @@
         component (thc/get-component file :component1)
 
         ;; ==== Action
-        changes (cll/generate-duplicate-component (pcb/empty-changes)
-                                                  file
-                                                  (:id component)
-                                                  true)
+        [_ changes]
+        (cll/generate-duplicate-component (pcb/empty-changes)
+                                          file
+                                          (:id component)
+                                          (uuid/next)
+                                          true)
 
         file'   (thf/apply-changes file changes)
 

common/test/common_tests/logic/comp_remove_swap_slots_test.cljc

@@ -61,10 +61,10 @@
         blue1                  (ths/get-shape file :blue1)
 
         ;; ==== Action
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       uuid/zero             ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -91,10 +91,10 @@
 
 
         ;; ==== Action
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id b2)              ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -121,10 +121,10 @@
 
         ;; ==== Action
         ;; Move blue1 into yellow
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id yellow)          ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -134,10 +134,10 @@
         yellow'                (ths/get-shape file' :frame-yellow)
 
         ;; Move yellow into root
-        changes'               (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page')
+        changes'               (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page'))
+                                                          (pcb/with-objects (:objects page')))
                                                       uuid/zero               ;; parent-id
-                                                      (:id page')             ;; page-id
                                                       0                       ;; to-index
                                                       #{(:id yellow')})       ;; ids
 
@@ -164,10 +164,10 @@
 
         ;; ==== Action
         ;; Move blue1 into yellow
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id yellow)          ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -178,10 +178,10 @@
         b2'                    (ths/get-shape file' :frame-b2)
 
         ;; Move yellow into b2
-        changes'               (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page')
+        changes'               (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page'))
+                                                          (pcb/with-objects (:objects page')))
                                                       (:id b2')               ;; parent-id
-                                                      (:id page')             ;; page-id
                                                       0                       ;; to-index
                                                       #{(:id yellow')})       ;; ids
 
@@ -254,10 +254,10 @@
 
         ;; ==== Action
         ;; Move blue1 into yellow
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id yellow)          ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -308,10 +308,10 @@
         blue1                  (ths/get-shape file :blue1)
 
         ;; ==== Action
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:parent-id blue1)    ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       2                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -338,10 +338,10 @@
 
         ;; ==== Action
         ;; Move blue1 into yellow
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id yellow)          ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -351,10 +351,10 @@
         page'                  (thf/current-page file')
         blue1'                 (ths/get-shape file' :blue1)
         b1'                    (ths/get-shape file' :frame-b1)
-        changes'               (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page')
+        changes'               (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page'))
+                                                          (pcb/with-objects (:objects page')))
                                                       (:id b1')             ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1')})      ;; ids
 
@@ -382,10 +382,10 @@
 
         ;; ==== Action
         ;; Relocate blue1 into yellow
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id yellow)          ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id blue1)})       ;; ids
 
@@ -396,10 +396,10 @@
         page'                  (thf/current-page file')
         blue1'                 (ths/get-shape file' :blue1)
         b1'                    (ths/get-shape file' :frame-b1)
-        changes'               (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page')
+        changes'               (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page'))
+                                                          (pcb/with-objects (:objects page')))
                                                       (:id b1')          ;; parent-id
-                                                      (:id page')        ;; page-id
                                                       0                  ;; to-index
                                                       #{(:id blue1')})   ;; ids
 
@@ -428,10 +428,10 @@
         green-copy             (ths/get-shape file :green-copy)
 
         ;; ==== Action
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       uuid/zero                  ;; parent-id
-                                                      (:id page)                 ;; page-id
                                                       0                          ;; to-index
                                                       #{(:id green-copy)})       ;; ids
 
@@ -459,10 +459,10 @@
         b2                     (ths/get-shape file :frame-b2)
 
         ;; ==== Action
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id b2)                   ;; parent-id
-                                                      (:id page)                 ;; page-id
                                                       0                          ;; to-index
                                                       #{(:id green-copy)})       ;; ids
 

common/test/common_tests/logic/comp_reset_test.cljc

@@ -136,10 +136,10 @@
 
         ;; IMPORTANT: as modifying copies structure is now forbidden, this action
         ;; will not have any effect, and so the parent shape won't also be touched.
-        changes (cls/generate-relocate (pcb/empty-changes)
-                                       (:objects page)
+        changes (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                           (pcb/with-page-id (:id page))
+                                           (pcb/with-objects (:objects page)))
                                        (thi/id :copy-root)      ; parent-id
-                                       (:id page)               ; page-id
                                        0                        ; to-index
                                        #{(thi/id :free-shape)}) ; ids
 
@@ -231,10 +231,10 @@
 
         ;; IMPORTANT: as modifying copies structure is now forbidden, this action
         ;; will not have any effect, and so the parent shape won't also be touched.
-        changes (cls/generate-relocate (pcb/empty-changes)
-                                       (:objects page)
+        changes (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                           (pcb/with-page-id (:id page))
+                                           (pcb/with-objects (:objects page)))
                                        (thi/id :copy-root)      ; parent-id
-                                       (:id page)               ; page-id
                                        2                        ; to-index
                                        #{(:id copy-child1)})     ; ids
 

common/test/common_tests/logic/comp_sync_test.cljc

@@ -195,10 +195,10 @@
         page      (thf/current-page file)
 
         ;; ==== Action
-        changes1 (cls/generate-relocate (pcb/empty-changes)
-                                        (:objects page)
+        changes1 (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                            (pcb/with-page-id (:id page))
+                                            (pcb/with-objects (:objects page)))
                                         (thi/id :main-root)       ; parent-id
-                                        (:id page)                ; page-id
                                         0                         ; to-index
                                         #{(thi/id :free-shape)})   ; ids
 
@@ -292,10 +292,10 @@
         main-child1 (ths/get-shape file :main-child1)
 
         ;; ==== Action
-        changes1     (cls/generate-relocate (pcb/empty-changes)
-                                            (:objects page)
+        changes1     (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                (pcb/with-page-id (:id page))
+                                                (pcb/with-objects (:objects page)))
                                             (thi/id :main-root)         ; parent-id
-                                            (:id page)                  ; page-id
                                             2                           ; to-index
                                             #{(:id main-child1)})       ; ids
 

common/test/common_tests/logic/comp_touched_test.cljc

@@ -112,10 +112,10 @@
 
         ;; IMPORTANT: as modifying copies structure is now forbidden, this action
         ;; will not have any effect, and so the parent shape won't also be touched.
-        changes (cls/generate-relocate (pcb/empty-changes)
-                                       (:objects page)
+        changes (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                           (pcb/with-page-id (:id page))
+                                           (pcb/with-objects (:objects page)))
                                        (thi/id :copy-root)       ; parent-id
-                                       (:id page)                ; page-id
                                        0                         ; to-index
                                        #{(thi/id :free-shape)})   ; ids
 
@@ -187,10 +187,10 @@
 
         ;; IMPORTANT: as modifying copies structure is now forbidden, this action
         ;; will not have any effect, and so the parent shape won't also be touched.
-        changes (cls/generate-relocate (pcb/empty-changes)
-                                       (:objects page)
+        changes (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                           (pcb/with-page-id (:id page))
+                                           (pcb/with-objects (:objects page)))
                                        (thi/id :copy-root)         ; parent-id
-                                       (:id page)                  ; page-id
                                        2                           ; to-index
                                        #{(:id copy-child1)})       ; ids
 

common/test/common_tests/logic/move_shapes_test.cljc

@@ -29,10 +29,10 @@
 
         ;; ==== Action
 
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       (:id frame-parent)       ;; parent-id
-                                                      (:id page)               ;; page-id
                                                       0                        ;; to-index
                                                       #{(:id frame-to-move)})  ;; ids
 
@@ -61,10 +61,10 @@
 
         ;; ==== Action
 
-        changes                (cls/generate-relocate (pcb/empty-changes nil)
-                                                      (:objects page)
+        changes                (cls/generate-relocate (-> (pcb/empty-changes nil)
+                                                          (pcb/with-page-id (:id page))
+                                                          (pcb/with-objects (:objects page)))
                                                       uuid/zero             ;; parent-id
-                                                      (:id page)            ;; page-id
                                                       0                     ;; to-index
                                                       #{(:id circle)})      ;; ids
 

common/test/common_tests/logic/token_test.cljc

@@ -22,7 +22,9 @@
                                 (ctob/add-theme (ctob/make-token-theme :name "theme"
                                                                        :sets #{"foo/bar"}))
                                 (ctob/set-active-themes #{"/theme"})))
-          changes (clt/generate-toggle-token-set (pcb/empty-changes) (tht/get-tokens-lib file) "foo/bar")
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (clt/generate-toggle-token-set (tht/get-tokens-lib file) "foo/bar"))
 
           redo (thf/apply-changes file changes)
           redo-lib (tht/get-tokens-lib redo)
@@ -32,7 +34,6 @@
       (t/is (= #{} (:sets (ctob/get-hidden-theme redo-lib))))
 
       ;; Undo
-      (t/is (nil? (ctob/get-hidden-theme undo-lib)))
       (t/is (= #{"/theme"} (ctob/get-active-theme-paths undo-lib)))))
 
   (t/testing "toggling an inactive set will switch to hidden theme without user sets"
@@ -41,7 +42,9 @@
                                 (ctob/add-theme (ctob/make-token-theme :name "theme"
                                                                        :sets #{"foo/bar"}))
                                 (ctob/set-active-themes #{"/theme"})))
-          changes (clt/generate-toggle-token-set (pcb/empty-changes) (tht/get-tokens-lib file) "foo/bar")
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (clt/generate-toggle-token-set (tht/get-tokens-lib file) "foo/bar"))
 
           redo (thf/apply-changes file changes)
           redo-lib (tht/get-tokens-lib redo)
@@ -51,7 +54,6 @@
       (t/is (= #{} (:sets (ctob/get-hidden-theme redo-lib))))
 
       ;; Undo
-      (t/is (nil? (ctob/get-hidden-theme undo-lib)))
       (t/is (= #{"/theme"} (ctob/get-active-theme-paths undo-lib)))))
 
   (t/testing "toggling an set with hidden theme already active will toggle set in hidden theme"
@@ -60,7 +62,9 @@
                                 (ctob/add-theme (ctob/make-hidden-token-theme))
                                 (ctob/set-active-themes #{ctob/hidden-token-theme-path})))
 
-          changes (clt/generate-toggle-token-set-group (pcb/empty-changes) (tht/get-tokens-lib file) ["foo"])
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (clt/generate-toggle-token-set-group (tht/get-tokens-lib file) ["foo"]))
 
           redo (thf/apply-changes file changes)
           redo-lib (tht/get-tokens-lib redo)
@@ -68,10 +72,210 @@
           undo-lib (tht/get-tokens-lib undo)]
       (t/is (= (ctob/get-active-theme-paths redo-lib) (ctob/get-active-theme-paths undo-lib)))
 
-      (t/is (= #{"foo/bar"} (:sets (ctob/get-hidden-theme redo-lib))))
+      (t/is (= #{"foo/bar"} (:sets (ctob/get-hidden-theme redo-lib)))))))
+
+(t/deftest set-token-theme-test
+  (t/testing "delete token theme"
+    (let [theme-name "foo"
+          group "main"
+          file (setup-file #(-> %
+                                (ctob/add-theme (ctob/make-token-theme :name theme-name
+                                                                       :group group))))
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-theme group theme-name nil))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      ;; Redo
+      (t/is (nil? (ctob/get-theme redo-lib group theme-name)))
+      ;; Undo
+      (t/is (some? (ctob/get-theme undo-lib group theme-name)))))
+
+  (t/testing "add token theme"
+    (let [theme-name "foo"
+          group "main"
+          theme (ctob/make-token-theme :name theme-name
+                                       :group group)
+          file (setup-file identity)
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-theme group theme-name theme))
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      ;; Redo
+      (t/is (some? (ctob/get-theme redo-lib group theme-name)))
+      ;; Undo
+      (t/is (nil? (ctob/get-theme undo-lib group theme-name)))))
+
+  (t/testing "update token theme"
+    (let [theme-name "foo"
+          group "main"
+          prev-theme (ctob/make-token-theme :name theme-name
+                                            :group group)
+          file (setup-file #(ctob/add-theme % prev-theme))
+          new-theme-name "foo1"
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-theme group new-theme-name prev-theme))
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      ;; Redo
+      (t/is (some? (ctob/get-theme redo-lib group theme-name)))
+      (t/is (nil? (ctob/get-theme redo-lib group new-theme-name)))
+      ;; Undo
+      (t/is (some? (ctob/get-theme undo-lib group theme-name)))
+      (t/is (nil? (ctob/get-theme undo-lib group new-theme-name)))))
+
+  (t/testing "toggling token theme updates using changes history"
+    (let [theme-name "foo-theme"
+          group "main"
+          set-name "bar-set"
+          token-set (ctob/make-token-set :name set-name)
+          theme (ctob/make-token-theme :name theme-name
+                                       :group group)
+          file (setup-file #(-> %
+                                (ctob/add-theme theme)
+                                (ctob/add-set token-set)))
+          theme' (assoc theme :sets #{set-name})
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-theme group theme-name theme'))
+          changed-file (-> file
+                           (thf/apply-changes changes)
+                           (thf/apply-undo-changes changes)
+                           (thf/apply-changes changes))
+          changed-lib (tht/get-tokens-lib changed-file)]
+      (t/is (= #{set-name}
+               (-> changed-lib (ctob/get-theme group theme-name) :sets))))))
+
+(t/deftest set-token-test
+  (t/testing "delete token"
+    (let [set-name "foo"
+          token-name "to.delete.color.red"
+          file (setup-file #(-> %
+                                (ctob/add-set (ctob/make-token-set :name set-name))
+                                (ctob/add-token-in-set set-name (ctob/make-token {:name token-name
+                                                                                  :value "red"
+                                                                                  :type :color}))))
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token set-name token-name nil))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      (t/is (nil? (ctob/get-token-in-set redo-lib set-name token-name)))
+      ;; Undo
+      (t/is (some? (ctob/get-token-in-set undo-lib set-name token-name)))))
+
+  (t/testing "add token"
+    (let [set-name "foo"
+          token (ctob/make-token {:name "to.add.color.red"
+                                  :value "red"
+                                  :type :color})
+          file (setup-file #(-> % (ctob/add-set (ctob/make-token-set :name set-name))))
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token set-name (:name token) token))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      (t/is (= token (ctob/get-token-in-set redo-lib set-name (:name token))))
+      ;; Undo
+      (t/is (nil? (ctob/get-token-in-set undo-lib set-name (:name token))))))
+
+  (t/testing "update token"
+    (let [set-name "foo"
+          prev-token (ctob/make-token {:name "to.update.color.red"
+                                       :value "red"
+                                       :type :color})
+          token (-> prev-token
+                    (assoc :name "color.red.changed")
+                    (assoc :value "blue"))
+          file (setup-file #(-> %
+                                (ctob/add-set (ctob/make-token-set :name set-name))
+                                (ctob/add-token-in-set set-name prev-token)))
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token set-name (:name prev-token) token))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      (t/is (tht/token-data-eq? token (ctob/get-token-in-set redo-lib set-name (:name token))))
+      (t/is (nil? (ctob/get-token-in-set redo-lib set-name (:name prev-token))))
+      ;; Undo
+      (t/is (tht/token-data-eq? prev-token (ctob/get-token-in-set undo-lib set-name (:name prev-token))))
+      (t/is (nil? (ctob/get-token-in-set undo-lib set-name (:name token)))))))
+
+(t/deftest set-token-set-test
+  (t/testing "delete token set"
+    (let [set-name "foo"
+          file (setup-file #(ctob/add-set % (ctob/make-token-set :name set-name)))
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-set set-name false nil))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      (t/is (not (ctob/set-path-exists? redo-lib [set-name])))
+      ;; Undo
+      (t/is (ctob/set-path-exists? undo-lib [set-name]))))
+
+  (t/testing "add token set"
+    (let [set-name "foo"
+          token-set (ctob/make-token-set :name set-name)
+          file (setup-file identity)
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-set set-name false token-set))
+
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
+      (t/is (not (ctob/set-path-exists? undo-lib [set-name])))
+      ;; Undo
+      (t/is (ctob/set-path-exists? redo-lib [set-name]))))
+
+  (t/testing "update token set"
+    (let [set-name "foo"
+          token-name "bar"
+          token (ctob/make-token {:name token-name
+                                  :value "red"
+                                  :type :color})
+          file (setup-file #(-> (ctob/add-set % (ctob/make-token-set :name set-name))
+                                (ctob/add-token-in-set set-name token)))
+          prev-token-set (-> file tht/get-tokens-lib :sets first)
+          new-set-name "foo1"
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (pcb/set-token-set set-name false (assoc prev-token-set
+                                                               :name new-set-name)))
+          redo (thf/apply-changes file changes)
+          redo-lib (tht/get-tokens-lib redo)
+          undo (thf/apply-undo-changes redo changes)
+          undo-lib (tht/get-tokens-lib undo)]
 
       ;; Undo
-      (t/is (some? (ctob/get-hidden-theme undo-lib))))))
+      (t/is (some? (ctob/get-token-in-set undo-lib set-name token-name)))
+      (t/is (nil? (ctob/get-token-in-set undo-lib new-set-name token-name)))
+      ;; Redo
+      (t/is (nil? (ctob/get-token-in-set redo-lib set-name token-name)))
+      (t/is (some? (ctob/get-token-in-set redo-lib new-set-name token-name))))))
 
 (t/deftest generate-toggle-token-set-group-test
   (t/testing "toggling set group with no active sets inside will activate all child sets"
@@ -81,7 +285,9 @@
                                 (ctob/add-set (ctob/make-token-set :name "foo/bar/baz/baz-child"))
                                 (ctob/add-theme (ctob/make-token-theme :name "theme"))
                                 (ctob/set-active-themes #{"/theme"})))
-          changes (clt/generate-toggle-token-set-group (pcb/empty-changes) (tht/get-tokens-lib file) ["foo" "bar"])
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (clt/generate-toggle-token-set-group (tht/get-tokens-lib file) ["foo" "bar"]))
 
           redo (thf/apply-changes file changes)
           redo-lib (tht/get-tokens-lib redo)
@@ -91,7 +297,6 @@
       (t/is (= #{"foo/bar/baz" "foo/bar/baz/baz-child"} (:sets (ctob/get-hidden-theme redo-lib))))
 
       ;; Undo
-      (t/is (nil? (ctob/get-hidden-theme undo-lib)))
       (t/is (= #{"/theme"} (ctob/get-active-theme-paths undo-lib)))))
 
   (t/testing "toggling set group with partially active sets inside will deactivate all child sets"
@@ -103,7 +308,9 @@
                                                                        :sets #{"foo/bar/baz"}))
                                 (ctob/set-active-themes #{"/theme"})))
 
-          changes (clt/generate-toggle-token-set-group (pcb/empty-changes) (tht/get-tokens-lib file) ["foo" "bar"])
+          changes (-> (pcb/empty-changes)
+                      (pcb/with-library-data (:data file))
+                      (clt/generate-toggle-token-set-group (tht/get-tokens-lib file) ["foo" "bar"]))
 
           redo (thf/apply-changes file changes)
           redo-lib (tht/get-tokens-lib redo)
@@ -113,7 +320,6 @@
       (t/is (= #{ctob/hidden-token-theme-path} (ctob/get-active-theme-paths redo-lib)))
 
       ;; Undo
-      (t/is (nil? (ctob/get-hidden-theme undo-lib)))
       (t/is (= #{"/theme"} (ctob/get-active-theme-paths undo-lib))))))
 
 (t/deftest generate-move-token-set-test

common/test/common_tests/logic/variants_test.cljc

@@ -0,0 +1,194 @@
+;; 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 common-tests.logic.variants-test
+  (:require
+   [app.common.files.changes-builder :as pcb]
+   [app.common.logic.variants :as clv]
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.files :as thf]
+   [app.common.test-helpers.ids-map :as thi]
+   [app.common.test-helpers.shapes :as ths]
+   [app.common.test-helpers.variants :as thv]
+   [clojure.test :as t]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+(t/deftest test-update-property-name
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        v-id    (-> (ths/get-shape file :v01) :id)
+        page    (thf/current-page file)
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-update-property-name v-id 0 "NewName1")
+                    (clv/generate-update-property-name v-id 1 "NewName2"))
+
+
+        file'   (thf/apply-changes file changes)
+
+
+
+        ;; ==== Get
+        comp01' (thc/get-component file' :c01)
+        comp02' (thc/get-component file' :c02)]
+
+    ;; ==== Check
+    (t/is (= (-> comp01' :variant-properties first :name) "NewName1"))
+    (t/is (= (-> comp01' :variant-properties last :name) "NewName2"))
+    (t/is (= (-> comp02' :variant-properties first :name) "NewName1"))
+    (t/is (= (-> comp02' :variant-properties last :name) "NewName2"))))
+
+
+
+(t/deftest test-add-new-property-without-values
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        v-id    (-> (ths/get-shape file :v01) :id)
+        page    (thf/current-page file)
+
+        comp01  (thc/get-component file :c01)
+        comp02  (thc/get-component file :c02)
+
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-add-new-property v-id))
+
+
+        file'   (thf/apply-changes file changes)
+
+
+
+        ;; ==== Get
+        comp01' (thc/get-component file' :c01)
+        comp02' (thc/get-component file' :c02)]
+
+    ;; ==== Check
+    (t/is (= (count (:variant-properties comp01)) 1))
+    (t/is (= (count (:variant-properties comp01')) 2))
+    (t/is (= (count (:variant-properties comp02)) 1))
+    (t/is (= (count (:variant-properties comp02')) 2))
+    (t/is (= (-> comp01' :variant-properties last :value) ""))))
+
+
+
+(t/deftest test-add-new-property-with-values
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        v-id    (-> (ths/get-shape file :v01) :id)
+        page    (thf/current-page file)
+
+        comp01  (thc/get-component file :c01)
+        comp02  (thc/get-component file :c02)
+
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-add-new-property v-id {:fill-values? true}))
+
+
+        file'   (thf/apply-changes file changes)
+
+
+
+        ;; ==== Get
+        comp01' (thc/get-component file' :c01)
+        comp02' (thc/get-component file' :c02)]
+
+    ;; ==== Check
+    (t/is (= (count (:variant-properties comp01)) 1))
+    (t/is (= (count (:variant-properties comp01')) 2))
+    (t/is (= (count (:variant-properties comp02)) 1))
+    (t/is (= (count (:variant-properties comp02')) 2))
+    (t/is (= (-> comp01' :variant-properties last :value) "Value1"))))
+
+
+
+(t/deftest test-remove-property
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        v-id    (-> (ths/get-shape file :v01) :id)
+        page    (thf/current-page file)
+
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-add-new-property v-id))
+
+
+        file    (thf/apply-changes file changes)
+        page    (thf/current-page file)
+
+        comp01  (thc/get-component file :c01)
+        comp02  (thc/get-component file :c02)
+
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-remove-property v-id 0))
+
+
+        file'   (thf/apply-changes file changes)
+
+
+
+        ;; ==== Get
+        comp01' (thc/get-component file' :c01)
+        comp02' (thc/get-component file' :c02)]
+
+    ;; ==== Check
+    (t/is (= (count (:variant-properties comp01)) 2))
+    (t/is (= (count (:variant-properties comp01')) 1))
+    (t/is (= (count (:variant-properties comp02)) 2))
+    (t/is (= (count (:variant-properties comp02')) 1))
+    (t/is (= (-> comp01' :variant-properties first :name) "Property2"))))
+
+(t/deftest test-update-property-value
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+
+        page    (thf/current-page file)
+
+        comp01  (thc/get-component file :c01)
+        comp02  (thc/get-component file :c02)
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (clv/generate-update-property-value (:id comp01) 0 "NewValue1")
+                    (clv/generate-update-property-value (:id comp02) 0 "NewValue2"))
+
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        comp01' (thc/get-component file' :c01)
+        comp02' (thc/get-component file' :c02)]
+
+    ;; ==== Check
+    (t/is (= (-> comp01' :variant-properties first :value) "NewValue1"))
+    (t/is (= (-> comp02' :variant-properties first :value) "NewValue2"))))

common/test/common_tests/types/data/legacy-single-set.json

@@ -0,0 +1,6 @@
+{"color":
+ {"red":
+  {"100":
+   {"value":"red",
+    "type":"color",
+    "description":""}}}}

common/test/common_tests/types/data/single-set.json

@@ -0,0 +1,6 @@
+{"color":
+ {"red":
+  {"100":
+   {"$value":"red",
+    "$type":"color",
+    "$description":""}}}}

common/test/common_tests/types/data/tokens-default-team-only.json

@@ -0,0 +1,11 @@
+{
+ "dark": 
+    {"small":
+        {"$value": "8",
+         "$type":"borderRadius",
+         "$description":""}},
+ "$themes": [],
+ "$metadata": 
+    {"tokenSetOrder": ["dark"],
+     "activeThemes": [],
+     "activeSets": ["dark"]}}

common/test/common_tests/types/data/tokens-multi-set-example.json

@@ -805,6 +805,8 @@
     "selectedTokenSets": {"light": "enabled"}
   } ],
   "$metadata": {
-    "tokenSetOrder": ["core", "light", "dark", "theme"]
+    "tokenSetOrder": ["core", "light", "dark", "theme"],
+    "activeSets": {}, 
+    "activeThemes": {}
   }
 }

common/test/common_tests/types/data/tokens-multi-set-legacy-example.json

@@ -0,0 +1,810 @@
+{
+  "core": {
+    "dimension": {
+      "scale": {
+        "value": "2",
+        "type": "dimension"
+      },
+      "xs": {
+        "value": "4",
+        "type": "dimension"
+      },
+      "sm": {
+        "value": "{dimension.xs} * {dimension.scale}",
+        "type": "dimension"
+      },
+      "md": {
+        "value": "{dimension.sm} * {dimension.scale}",
+        "type": "dimension"
+      },
+      "lg": {
+        "value": "{dimension.md} * {dimension.scale}",
+        "type": "dimension"
+      },
+      "xl": {
+        "value": "{dimension.lg} * {dimension.scale}",
+        "type": "dimension"
+      }
+    },
+    "spacing": {
+      "xs": {
+        "value": "{dimension.xs}",
+        "type": "spacing"
+      },
+      "sm": {
+        "value": "{dimension.sm}",
+        "type": "spacing"
+      },
+      "md": {
+        "value": "{dimension.md}",
+        "type": "spacing"
+      },
+      "lg": {
+        "value": "{dimension.lg}",
+        "type": "spacing"
+      },
+      "xl": {
+        "value": "{dimension.xl}",
+        "type": "spacing"
+      },
+      "multi-value": {
+        "value": "{dimension.sm} {dimension.xl}",
+        "type": "spacing",
+        "$description": "You can have multiple values in a single spacing token"
+      }
+    },
+    "borderRadius": {
+      "sm": {
+        "value": "4",
+        "type": "borderRadius"
+      },
+      "lg": {
+        "value": "8",
+        "type": "borderRadius"
+      },
+      "xl": {
+        "value": "16",
+        "type": "borderRadius"
+      },
+      "multi-value": {
+        "value": "{borderRadius.sm} {borderRadius.lg}",
+        "type": "borderRadius",
+        "$description": "You can have multiple values in a single radius token. Read more on these: https://docs.tokens.studio/available-tokens/border-radius-tokens#single--multiple-values"
+      }
+    },
+    "colors": {
+      "black": {
+        "value": "#000000",
+        "type": "color"
+      },
+      "white": {
+        "value": "#ffffff",
+        "type": "color"
+      },
+      "gray": {
+        "100": {
+          "value": "#f7fafc",
+          "type": "color"
+        },
+        "200": {
+          "value": "#edf2f7",
+          "type": "color"
+        },
+        "300": {
+          "value": "#e2e8f0",
+          "type": "color"
+        },
+        "400": {
+          "value": "#cbd5e0",
+          "type": "color"
+        },
+        "500": {
+          "value": "#a0aec0",
+          "type": "color"
+        },
+        "600": {
+          "value": "#718096",
+          "type": "color"
+        },
+        "700": {
+          "value": "#4a5568",
+          "type": "color"
+        },
+        "800": {
+          "value": "#2d3748",
+          "type": "color"
+        },
+        "900": {
+          "value": "#1a202c",
+          "type": "color"
+        }
+      },
+      "red": {
+        "100": {
+          "value": "#fff5f5",
+          "type": "color"
+        },
+        "200": {
+          "value": "#fed7d7",
+          "type": "color"
+        },
+        "300": {
+          "value": "#feb2b2",
+          "type": "color"
+        },
+        "400": {
+          "value": "#fc8181",
+          "type": "color"
+        },
+        "500": {
+          "value": "#f56565",
+          "type": "color"
+        },
+        "600": {
+          "value": "#e53e3e",
+          "type": "color"
+        },
+        "700": {
+          "value": "#c53030",
+          "type": "color"
+        },
+        "800": {
+          "value": "#9b2c2c",
+          "type": "color"
+        },
+        "900": {
+          "value": "#742a2a",
+          "type": "color"
+        }
+      },
+      "orange": {
+        "100": {
+          "value": "#fffaf0",
+          "type": "color"
+        },
+        "200": {
+          "value": "#feebc8",
+          "type": "color"
+        },
+        "300": {
+          "value": "#fbd38d",
+          "type": "color"
+        },
+        "400": {
+          "value": "#f6ad55",
+          "type": "color"
+        },
+        "500": {
+          "value": "#ed8936",
+          "type": "color"
+        },
+        "600": {
+          "value": "#dd6b20",
+          "type": "color"
+        },
+        "700": {
+          "value": "#c05621",
+          "type": "color"
+        },
+        "800": {
+          "value": "#9c4221",
+          "type": "color"
+        },
+        "900": {
+          "value": "#7b341e",
+          "type": "color"
+        }
+      },
+      "yellow": {
+        "100": {
+          "value": "#fffff0",
+          "type": "color"
+        },
+        "200": {
+          "value": "#fefcbf",
+          "type": "color"
+        },
+        "300": {
+          "value": "#faf089",
+          "type": "color"
+        },
+        "400": {
+          "value": "#f6e05e",
+          "type": "color"
+        },
+        "500": {
+          "value": "#ecc94b",
+          "type": "color"
+        },
+        "600": {
+          "value": "#d69e2e",
+          "type": "color"
+        },
+        "700": {
+          "value": "#b7791f",
+          "type": "color"
+        },
+        "800": {
+          "value": "#975a16",
+          "type": "color"
+        },
+        "900": {
+          "value": "#744210",
+          "type": "color"
+        }
+      },
+      "green": {
+        "100": {
+          "value": "#f0fff4",
+          "type": "color"
+        },
+        "200": {
+          "value": "#c6f6d5",
+          "type": "color"
+        },
+        "300": {
+          "value": "#9ae6b4",
+          "type": "color"
+        },
+        "400": {
+          "value": "#68d391",
+          "type": "color"
+        },
+        "500": {
+          "value": "#48bb78",
+          "type": "color"
+        },
+        "600": {
+          "value": "#38a169",
+          "type": "color"
+        },
+        "700": {
+          "value": "#2f855a",
+          "type": "color"
+        },
+        "800": {
+          "value": "#276749",
+          "type": "color"
+        },
+        "900": {
+          "value": "#22543d",
+          "type": "color"
+        }
+      },
+      "teal": {
+        "100": {
+          "value": "#e6fffa",
+          "type": "color"
+        },
+        "200": {
+          "value": "#b2f5ea",
+          "type": "color"
+        },
+        "300": {
+          "value": "#81e6d9",
+          "type": "color"
+        },
+        "400": {
+          "value": "#4fd1c5",
+          "type": "color"
+        },
+        "500": {
+          "value": "#38b2ac",
+          "type": "color"
+        },
+        "600": {
+          "value": "#319795",
+          "type": "color"
+        },
+        "700": {
+          "value": "#2c7a7b",
+          "type": "color"
+        },
+        "800": {
+          "value": "#285e61",
+          "type": "color"
+        },
+        "900": {
+          "value": "#234e52",
+          "type": "color"
+        }
+      },
+      "blue": {
+        "100": {
+          "value": "#ebf8ff",
+          "type": "color"
+        },
+        "200": {
+          "value": "#bee3f8",
+          "type": "color"
+        },
+        "300": {
+          "value": "#90cdf4",
+          "type": "color"
+        },
+        "400": {
+          "value": "#63b3ed",
+          "type": "color"
+        },
+        "500": {
+          "value": "#4299e1",
+          "type": "color"
+        },
+        "600": {
+          "value": "#3182ce",
+          "type": "color"
+        },
+        "700": {
+          "value": "#2b6cb0",
+          "type": "color"
+        },
+        "800": {
+          "value": "#2c5282",
+          "type": "color"
+        },
+        "900": {
+          "value": "#2a4365",
+          "type": "color"
+        }
+      },
+      "indigo": {
+        "100": {
+          "value": "#ebf4ff",
+          "type": "color"
+        },
+        "200": {
+          "value": "#c3dafe",
+          "type": "color"
+        },
+        "300": {
+          "value": "#a3bffa",
+          "type": "color"
+        },
+        "400": {
+          "value": "#7f9cf5",
+          "type": "color"
+        },
+        "500": {
+          "value": "#667eea",
+          "type": "color"
+        },
+        "600": {
+          "value": "#5a67d8",
+          "type": "color"
+        },
+        "700": {
+          "value": "#4c51bf",
+          "type": "color"
+        },
+        "800": {
+          "value": "#434190",
+          "type": "color"
+        },
+        "900": {
+          "value": "#3c366b",
+          "type": "color"
+        }
+      },
+      "purple": {
+        "100": {
+          "value": "#faf5ff",
+          "type": "color"
+        },
+        "200": {
+          "value": "#e9d8fd",
+          "type": "color"
+        },
+        "300": {
+          "value": "#d6bcfa",
+          "type": "color"
+        },
+        "400": {
+          "value": "#b794f4",
+          "type": "color"
+        },
+        "500": {
+          "value": "#9f7aea",
+          "type": "color"
+        },
+        "600": {
+          "value": "#805ad5",
+          "type": "color"
+        },
+        "700": {
+          "value": "#6b46c1",
+          "type": "color"
+        },
+        "800": {
+          "value": "#553c9a",
+          "type": "color"
+        },
+        "900": {
+          "value": "#44337a",
+          "type": "color"
+        }
+      },
+      "pink": {
+        "100": {
+          "value": "#fff5f7",
+          "type": "color"
+        },
+        "200": {
+          "value": "#fed7e2",
+          "type": "color"
+        },
+        "300": {
+          "value": "#fbb6ce",
+          "type": "color"
+        },
+        "400": {
+          "value": "#f687b3",
+          "type": "color"
+        },
+        "500": {
+          "value": "#ed64a6",
+          "type": "color"
+        },
+        "600": {
+          "value": "#d53f8c",
+          "type": "color"
+        },
+        "700": {
+          "value": "#b83280",
+          "type": "color"
+        },
+        "800": {
+          "value": "#97266d",
+          "type": "color"
+        },
+        "900": {
+          "value": "#702459",
+          "type": "color"
+        }
+      }
+    },
+    "opacity": {
+      "low": {
+        "value": "10%",
+        "type": "opacity"
+      },
+      "md": {
+        "value": "50%",
+        "type": "opacity"
+      },
+      "high": {
+        "value": "90%",
+        "type": "opacity"
+      }
+    },
+    "fontFamilies": {
+      "heading": {
+        "value": "Inter",
+        "type": "fontFamilies"
+      },
+      "body": {
+        "value": "Roboto",
+        "type": "fontFamilies"
+      }
+    },
+    "lineHeights": {
+      "heading": {
+        "value": "110%",
+        "type": "lineHeights"
+      },
+      "body": {
+        "value": "140%",
+        "type": "lineHeights"
+      }
+    },
+    "letterSpacing": {
+      "default": {
+        "value": "0",
+        "type": "letterSpacing"
+      },
+      "increased": {
+        "value": "150%",
+        "type": "letterSpacing"
+      },
+      "decreased": {
+        "value": "-5%",
+        "type": "letterSpacing"
+      }
+    },
+    "paragraphSpacing": {
+      "h1": {
+        "value": "32",
+        "type": "paragraphSpacing"
+      },
+      "h2": {
+        "value": "26",
+        "type": "paragraphSpacing"
+      }
+    },
+    "fontWeights": {
+      "headingRegular": {
+        "value": "Regular",
+        "type": "fontWeights"
+      },
+      "headingBold": {
+        "value": "Bold",
+        "type": "fontWeights"
+      },
+      "bodyRegular": {
+        "value": "Regular",
+        "type": "fontWeights"
+      },
+      "bodyBold": {
+        "value": "Bold",
+        "type": "fontWeights"
+      }
+    },
+    "fontSizes": {
+      "h1": {
+        "value": "{fontSizes.h2} * 1.25",
+        "type": "fontSizes"
+      },
+      "h2": {
+        "value": "{fontSizes.h3} * 1.25",
+        "type": "fontSizes"
+      },
+      "h3": {
+        "value": "{fontSizes.h4} * 1.25",
+        "type": "fontSizes"
+      },
+      "h4": {
+        "value": "{fontSizes.h5} * 1.25",
+        "type": "fontSizes"
+      },
+      "h5": {
+        "value": "{fontSizes.h6} * 1.25",
+        "type": "fontSizes"
+      },
+      "h6": {
+        "value": "{fontSizes.body} * 1",
+        "type": "fontSizes"
+      },
+      "body": {
+        "value": "16",
+        "type": "fontSizes"
+      },
+      "sm": {
+        "value": "{fontSizes.body} * 0.85",
+        "type": "fontSizes"
+      },
+      "xs": {
+        "value": "{fontSizes.body} * 0.65",
+        "type": "fontSizes"
+      }
+    }
+  },
+  "light": {
+    "fg": {
+      "default": {
+        "value": "{colors.black}",
+        "type": "color"
+      },
+      "muted": {
+        "value": "{colors.gray.700}",
+        "type": "color"
+      },
+      "subtle": {
+        "value": "{colors.gray.500}",
+        "type": "color"
+      }
+    },
+    "bg": {
+      "default": {
+        "value": "{colors.white}",
+        "type": "color"
+      },
+      "muted": {
+        "value": "{colors.gray.100}",
+        "type": "color"
+      },
+      "subtle": {
+        "value": "{colors.gray.200}",
+        "type": "color"
+      }
+    },
+    "accent": {
+      "default": {
+        "value": "{colors.indigo.400}",
+        "type": "color"
+      },
+      "onAccent": {
+        "value": "{colors.white}",
+        "type": "color"
+      },
+      "bg": {
+        "value": "{colors.indigo.200}",
+        "type": "color"
+      }
+    },
+    "shadows": {
+      "default": {
+        "value": "{colors.gray.900}",
+        "type": "color"
+      }
+    }
+  },
+  "dark": {
+    "fg": {
+      "default": {
+        "value": "{colors.white}",
+        "type": "color"
+      },
+      "muted": {
+        "value": "{colors.gray.300}",
+        "type": "color"
+      },
+      "subtle": {
+        "value": "{colors.gray.500}",
+        "type": "color"
+      }
+    },
+    "bg": {
+      "default": {
+        "value": "{colors.gray.900}",
+        "type": "color"
+      },
+      "muted": {
+        "value": "{colors.gray.700}",
+        "type": "color"
+      },
+      "subtle": {
+        "value": "{colors.gray.600}",
+        "type": "color"
+      }
+    },
+    "accent": {
+      "default": {
+        "value": "{colors.indigo.600}",
+        "type": "color"
+      },
+      "onAccent": {
+        "value": "{colors.white}",
+        "type": "color"
+      },
+      "bg": {
+        "value": "{colors.indigo.800}",
+        "type": "color"
+      }
+    },
+    "shadows": {
+      "default": {
+        "value": "rgba({colors.black}, 0.3)",
+        "type": "color"
+      }
+    }
+  },
+  "theme": {
+    "button": {
+      "primary": {
+        "background": {
+          "value": "{accent.default}",
+          "type": "color"
+        },
+        "text": {
+          "value": "{accent.onAccent}",
+          "type": "color"
+        }
+      },
+      "borderRadius": {
+        "value": "{borderRadius.lg}",
+        "type": "borderRadius"
+      },
+      "borderWidth": {
+        "value": "{dimension.sm}",
+        "type": "borderWidth"
+      }
+    },
+    "card": {
+      "borderRadius": {
+        "value": "{borderRadius.lg}",
+        "type": "borderRadius"
+      },
+      "background": {
+        "value": "{bg.default}",
+        "type": "color"
+      },
+      "padding": {
+        "value": "{dimension.md}",
+        "type": "dimension"
+      }
+    },
+    "boxShadow": {
+      "default": {
+        "value": [
+          {
+            "x": 5,
+            "y": 5,
+            "spread": 3,
+            "color": "rgba({shadows.default}, 0.15)",
+            "blur": 5,
+            "type": "dropShadow"
+          },
+          {
+            "x": 4,
+            "y": 4,
+            "spread": 6,
+            "color": "#00000033",
+            "blur": 5,
+            "type": "innerShadow"
+          }
+        ],
+        "type": "boxShadow"
+      }
+    },
+    "typography": {
+      "H1": {
+        "Bold": {
+          "value": {
+            "fontFamily": "{fontFamilies.heading}",
+            "fontWeight": "{fontWeights.headingBold}",
+            "lineHeight": "{lineHeights.heading}",
+            "fontSize": "{fontSizes.h1}",
+            "paragraphSpacing": "{paragraphSpacing.h1}",
+            "letterSpacing": "{letterSpacing.decreased}"
+          },
+          "type": "typography"
+        },
+        "Regular": {
+          "value": {
+            "fontFamily": "{fontFamilies.heading}",
+            "fontWeight": "{fontWeights.headingRegular}",
+            "lineHeight": "{lineHeights.heading}",
+            "fontSize": "{fontSizes.h1}",
+            "paragraphSpacing": "{paragraphSpacing.h1}",
+            "letterSpacing": "{letterSpacing.decreased}"
+          },
+          "type": "typography"
+        }
+      },
+      "H2": {
+        "Bold": {
+          "value": {
+            "fontFamily": "{fontFamilies.heading}",
+            "fontWeight": "{fontWeights.headingBold}",
+            "lineHeight": "{lineHeights.heading}",
+            "fontSize": "{fontSizes.h2}",
+            "paragraphSpacing": "{paragraphSpacing.h2}",
+            "letterSpacing": "{letterSpacing.decreased}"
+          },
+          "type": "typography"
+        },
+        "Regular": {
+          "value": {
+            "fontFamily": "{fontFamilies.heading}",
+            "fontWeight": "{fontWeights.headingRegular}",
+            "lineHeight": "{lineHeights.heading}",
+            "fontSize": "{fontSizes.h2}",
+            "paragraphSpacing": "{paragraphSpacing.h2}",
+            "letterSpacing": "{letterSpacing.decreased}"
+          },
+          "type": "typography"
+        }
+      },
+      "Body": {
+        "value": {
+          "fontFamily": "{fontFamilies.body}",
+          "fontWeight": "{fontWeights.bodyRegular}",
+          "lineHeight": "{lineHeights.heading}",
+          "fontSize": "{fontSizes.body}",
+          "paragraphSpacing": "{paragraphSpacing.h2}"
+        },
+        "type": "typography"
+      }
+    }
+  },
+  "$themes": [ {
+    "name": "theme-1",
+    "group": "group-1",
+    "description": null,
+    "is-source": false,
+    "modified-at": "2024-01-01T00:00:00.000+00:00",
+    "selectedTokenSets": {"light": "enabled"}
+  } ],
+  "$metadata": {
+    "tokenSetOrder": ["core", "light", "dark", "theme"]
+  }
+}

docker/devenv/Dockerfile

@@ -9,7 +9,7 @@ ENV NODE_VERSION=v22.13.1 \
     BABASHKA_VERSION=1.12.196 \
     CLJFMT_VERSION=0.13.0 \
     RUSTUP_VERSION=1.27.1 \
-    RUST_VERSION=1.82.0 \
+    RUST_VERSION=1.85.0 \
     LANG=en_US.UTF-8 \
     LC_ALL=en_US.UTF-8
 
@@ -264,7 +264,8 @@ RUN set -eux; \
     ./rustup-init -y --no-modify-path --profile minimal --default-toolchain $RUST_VERSION --default-host ${rustArch}; \
     rm rustup-init; \
     chmod -R a+w $RUSTUP_HOME $CARGO_HOME; \
-    rustup component add rustfmt;
+    rustup component add rustfmt; \
+    rustup component add clippy;
 
 WORKDIR /usr/local
 

docker/devenv/files/nginx.conf

@@ -156,10 +156,13 @@ http {
         }
 
         location / {
-            location ~ ^/github/penpot-files/(?<template_file>[a-zA-Z0-9\-\_\.]+) {
-                proxy_pass https://raw.githubusercontent.com/penpot/penpot-files/main/$template_file;
+            location ~ ^/github/penpot-files/(.+)$ {
+                rewrite ^/github/penpot-files/(.+) /penpot/penpot-files/refs/heads/main/$1 break;
+                proxy_pass https://raw.githubusercontent.com;
+
                 proxy_hide_header Access-Control-Allow-Origin;
-                proxy_set_header User-Agent "curl/7.74.0";
+                proxy_hide_header Cookies;
+                proxy_set_header User-Agent "curl/8.5.0";
                 proxy_set_header Host "raw.githubusercontent.com";
                 proxy_set_header Accept "*/*";
                 add_header Access-Control-Allow-Origin $http_origin;

docker/devenv/files/start-tmux.sh

@@ -8,12 +8,12 @@ source ~/.bashrc
 
 echo "[start-tmux.sh] Installing node dependencies"
 pushd ~/penpot/frontend/
-corepack up;
+corepack install;
 yarn install;
 yarn run playwright install --with-deps chromium
 popd
 pushd ~/penpot/exporter/
-corepack up;
+corepack install;
 yarn install
 yarn run playwright install --with-deps chromium
 popd

docker/images/docker-compose.yaml

@@ -52,7 +52,7 @@ services:
   ## penpot to the internet, or a different host than `localhost`.
 
   # traefik:
-  #   image: traefik:v2.9
+  #   image: traefik:v3.3
   #   networks:
   #     - penpot
   #   command:
@@ -87,29 +87,16 @@ services:
     networks:
       - penpot
 
-    labels:
-      - "traefik.enable=true"
+    # labels:
+      # - "traefik.enable=true"
 
-      ## HTTP: example of labels for the case where penpot will be exposed to the
-      ## internet with only HTTP (without HTTPS) using traefik.
+      # ## HTTPS: example of labels for the case where penpot will be exposed to the
+      # ## internet with HTTPS using traefik.
 
-      # - "traefik.http.routers.penpot-http.entrypoints=web"
-      # - "traefik.http.routers.penpot-http.rule=Host(`<DOMAIN_NAME>`)"
-      # - "traefik.http.services.penpot-http.loadbalancer.server.port=80"
-
-      ## HTTPS: example of labels for the case where penpot will be exposed to the
-      ## internet with HTTPS using traefik.
-
-      # - "traefik.http.middlewares.http-redirect.redirectscheme.scheme=https"
-      # - "traefik.http.middlewares.http-redirect.redirectscheme.permanent=true"
-      # - "traefik.http.routers.penpot-http.entrypoints=web"
-      # - "traefik.http.routers.penpot-http.rule=Host(`<DOMAIN_NAME>`)"
-      # - "traefik.http.routers.penpot-http.middlewares=http-redirect"
-      # - "traefik.http.routers.penpot-https.entrypoints=websecure"
       # - "traefik.http.routers.penpot-https.rule=Host(`<DOMAIN_NAME>`)"
-      # - "traefik.http.services.penpot-https.loadbalancer.server.port=80"
-      # - "traefik.http.routers.penpot-https.tls=true"
+      # - "traefik.http.routers.penpot-https.entrypoints=websecure"
       # - "traefik.http.routers.penpot-https.tls.certresolver=letsencrypt"
+      # - "traefik.http.routers.penpot-https.tls=true"
 
     environment:
       << : [*penpot-flags, *penpot-http-body-size]
@@ -130,8 +117,7 @@ services:
     networks:
       - penpot
 
-    ## Configuration envronment variables for the backend
-    ## container.
+    ## Configuration envronment variables for the backend container.
 
     environment:
       << : [*penpot-flags, *penpot-public-uri, *penpot-http-body-size]

docker/images/files/nginx.conf

@@ -135,10 +135,13 @@ http {
         }
 
         location / {
-            location ~ ^/github/penpot-files/(?<template_file>[a-zA-Z0-9\-\_\.]+) {
-                proxy_pass https://raw.githubusercontent.com/penpot/penpot-files/main/$template_file;
+            location ~ ^/github/penpot-files/(.+)$ {
+                rewrite ^/github/penpot-files/(.+) /penpot/penpot-files/refs/heads/main/$1 break;
+                proxy_pass https://raw.githubusercontent.com;
+
                 proxy_hide_header Access-Control-Allow-Origin;
-                proxy_set_header User-Agent "curl/7.74.0";
+                proxy_hide_header Cookies;
+                proxy_set_header User-Agent "curl/8.5.0";
                 proxy_set_header Host "raw.githubusercontent.com";
                 proxy_set_header Accept "*/*";
                 add_header Access-Control-Allow-Origin $http_origin;