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

backend/src/app/media.clj

@@ -59,8 +59,8 @@
                           :hint "seems like the url points to resource with unknown size"))
 
               (-> {:size size :mtype mtype}
-                  (validation/validate-media-type!)
-                  (validation/validate-media-size!))))]
+                  (validation/check-media-type)
+                  (validation/check-media-size))))]
 
     (let [{:keys [body] :as response}
           (try

backend/src/app/media/validation.clj

@@ -32,8 +32,26 @@
 (def check-input
   (sm/check-fn schema:input))
 
-(defn validate-media-type!
-  ([upload] (validate-media-type! upload cm/image-types))
+(def allowed-upload-prefixes
+  ;; Upload temp files are created server-side by the multipart parser
+  ;; (yetti `default-temp-dir`, `/tmp/undertow/`) plus the tmp dir used
+  ;; by tests and storage tmp files (`/tmp/penpot/`). Anything else
+  ;; (e.g. `/etc/passwd` smuggled via Transit `~#path`) is rejected.
+  ["/tmp/undertow/" "/tmp/penpot/"])
+
+(defn check-upload-path
+  [upload]
+  (let [real (try (str (fs/real (:path upload)))
+                  (catch Exception _ nil))]
+    (when (or (nil? real)
+              (not (some #(str/starts-with? real %) allowed-upload-prefixes)))
+      (ex/raise :type :validation
+                :code :params-validation
+                :hint "invalid upload path"))
+    upload))
+
+(defn check-media-type
+  ([upload] (check-media-type upload cm/image-types))
   ([upload allowed]
    (when-not (contains? allowed (:mtype upload))
      (ex/raise :type :validation
@@ -42,7 +60,7 @@
 
    upload))
 
-(defn validate-media-size!
+(defn check-media-size
   [upload]
   (let [max-size (cf/get :media-max-file-size)]
     (when (> (:size upload) max-size)
@@ -53,10 +71,10 @@
                                 max-size)))
     upload))
 
-(defn validate-font-size!
+(defn check-font-size
   "Validates that the font file `upload` does not exceed the configured
   `:font-max-file-size` limit.  Accepts the same map shape as
-  `validate-media-size!` — requires a `:size` key in bytes."
+  `check-media-size` — requires a `:size` key in bytes."
   [upload]
   (let [max-size (cf/get :font-max-file-size)]
     (when (> (:size upload) max-size)

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

@@ -194,6 +194,8 @@
                     (assoc params :file file))
                   params)
 
+        _       (media.v/check-upload-path (:file params))
+
         version (or version
                     (case (bfc/parse-file-format (-> params :file :path))
                       :binfile-v1 1

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

@@ -302,8 +302,9 @@
    ::rpc/multipart-only-params [:media]}
 
   [cfg {:keys [::rpc/profile-id file-id object-id media tag]}]
-  (media.v/validate-media-type! media)
-  (media.v/validate-media-size! media)
+  (media.v/check-media-type media)
+  (media.v/check-media-size media)
+  (media.v/check-upload-path media)
 
   (db/run! cfg files/check-edition-permissions! profile-id file-id)
   (when-let [file (files/get-minimal-file cfg file-id {::db/check-deleted false})]
@@ -404,8 +405,9 @@
    ::rpc/multipart-only-params [:media]}
 
   [cfg {:keys [::rpc/profile-id file-id] :as params}]
-  (media.v/validate-media-type! (:media params))
-  (media.v/validate-media-size! (:media params))
+  (media.v/check-media-type (:media params))
+  (media.v/check-media-size (:media params))
+  (media.v/check-upload-path (:media params))
 
   (db/run! cfg files/check-edition-permissions! profile-id file-id)
 

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

@@ -123,8 +123,8 @@
               (fn [acc mtype session-id]
                 (let [assembled (assemble-chunks cfg profile-id session-id)]
                   (-> {:mtype mtype :size (:size assembled)}
-                      (media.v/validate-media-type! cm/font-types)
-                      (media.v/validate-font-size!))
+                      (media.v/check-media-type cm/font-types)
+                      (media.v/check-font-size))
                   (assoc acc mtype (:path assembled))))
               {}
               uploads)]

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

@@ -65,8 +65,9 @@
                 [:process-image/global]]}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
   (files/check-edition-permissions! pool profile-id file-id)
-  (media.v/validate-media-type! content)
-  (media.v/validate-media-size! content)
+  (media.v/check-media-type content)
+  (media.v/check-media-size content)
+  (media.v/check-upload-path content)
 
   (let [team-id (:team-id (db/exec-one! pool [sql:get-team-id-for-file file-id]))]
     ;; TEMPORARILY DISABLED (2026-10-19): media-storage-bytes-per-team
@@ -376,6 +377,7 @@
    ::sm/result schema:upload-chunk-result}
   [{:keys [::db/pool] :as cfg}
    {:keys [::rpc/profile-id session-id index content] :as _params}]
+  (media.v/check-upload-path content)
   (let [session (db/tx-run! cfg check-upload-chunk-slot session-id profile-id index content)]
     (l/trc :hint "upload-chunk"
            :session-id session-id
@@ -576,8 +578,8 @@
                       content (-> content
                                   (assoc :filename (str "upload:" name))
                                   (assoc :mtype mtype)
-                                  (media.v/validate-media-type!)
-                                  (media.v/validate-media-size!))
+                                  (media.v/check-media-type)
+                                  (media.v/check-media-size))
                       mobj    (create-file-media-object cfg (assoc params
                                                                    :from-chunks? true
                                                                    :content content))]

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

@@ -313,8 +313,9 @@
    ::sm/result :nil}
   [cfg {:keys [::rpc/profile-id file] :as params}]
   ;; Validate incoming mime type
-  (media.v/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (media.v/validate-media-size! file)
+  (media.v/check-media-type file #{"image/jpeg" "image/png" "image/webp"})
+  (media.v/check-media-size file)
+  (media.v/check-upload-path file)
   (update-profile-photo cfg (assoc params :profile-id profile-id)))
 
 (defn update-profile-photo

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

@@ -1102,8 +1102,9 @@
   [cfg {:keys [::rpc/profile-id file] :as params}]
   ;; Validate incoming mime type
 
-  (media.v/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (media.v/validate-media-size! file)
+  (media.v/check-media-type file #{"image/jpeg" "image/png" "image/webp"})
+  (media.v/check-media-size file)
+  (media.v/check-upload-path file)
   (update-team-photo cfg (assoc params :profile-id profile-id)))
 
 (defn update-team-photo

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

@@ -39,7 +39,8 @@
    ::sm/result schema:upload-tempfile-result
    ::rpc/allowed-shared-keys allowed-shared-key-ids}
   [cfg {:keys [::rpc/profile-id content]}]
-  (media.v/validate-media-type! content cm/tempfile-types)
+  (media.v/check-media-type content cm/tempfile-types)
+  (media.v/check-upload-path content)
   (let [storage (sto/resolve cfg)
         hash    (sto/calculate-hash (:path content))
         data    (-> (sto/content (:path content))

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

@@ -209,7 +209,8 @@
    ::sm/result schema:upload-organization-logo-result
    ::nitrate/sso false}
   [{:keys [::sto/storage]} {:keys [content organization-id previous-id]}]
-  (media.v/validate-media-type! content cm/image-types)
+  (media.v/check-media-type content cm/image-types)
+  (media.v/check-upload-path content)
   (when previous-id
     (sto/touch-object! storage previous-id))
   (let [hash (sto/calculate-hash (:path content))

backend/test/backend_tests/binfile_svg_test.clj

@@ -146,7 +146,7 @@
 (defn- write-temp-svg
   "Write `text` to a tempfile and return `[path size]`."
   [text]
-  (let [path (fs/create-tempfile :prefix "penpot-svg-import-test-" :suffix ".svg")
+  (let [path (fs/create-tempfile :dir "/tmp/penpot" :prefix "penpot-svg-import-test-" :suffix ".svg")
         data (utf8bytes text)]
     (spit (str path) text :encoding "UTF-8")
     [path (alength data)]))

backend/test/backend_tests/media_validation_test.clj

@@ -0,0 +1,68 @@
+;; 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 Sucursal en España SL
+
+(ns backend-tests.media-validation-test
+  (:require
+   [app.media.validation :as media.v]
+   [backend-tests.helpers :as th]
+   [clojure.test :as t]
+   [datoteka.fs :as fs]))
+
+(t/deftest check-media-type
+  (t/testing "allowed mtype passes through"
+    (let [upload {:filename "a.png" :size 1 :path (fs/path "/tmp/penpot/a.png") :mtype "image/png"}]
+      (t/is (= upload (media.v/check-media-type upload)))))
+  (t/testing "disallowed mtype is rejected"
+    (let [upload {:filename "a.txt" :size 1 :path (fs/path "/tmp/penpot/a.txt") :mtype "text/plain"}
+          error  (try (media.v/check-media-type upload) nil
+                      (catch clojure.lang.ExceptionInfo e e))]
+      (t/is (some? error))
+      (t/is (th/ex-of-type? error :validation))
+      (t/is (th/ex-of-code? error :media-type-not-allowed)))))
+
+(t/deftest check-media-size
+  (t/testing "small file passes through"
+    (let [upload {:filename "a.png" :size 1 :path (fs/path "/tmp/penpot/a.png") :mtype "image/png"}]
+      (t/is (= upload (media.v/check-media-size upload)))))
+  (t/testing "oversized file is rejected"
+    (let [upload {:filename "a.png" :size (* 1024 1024 31) :path (fs/path "/tmp/penpot/a.png") :mtype "image/png"}
+          error  (try (media.v/check-media-size upload) nil
+                      (catch clojure.lang.ExceptionInfo e e))]
+      (t/is (some? error))
+      (t/is (th/ex-of-type? error :restriction))
+      (t/is (th/ex-of-code? error :media-max-file-size-reached)))))
+
+(t/deftest check-font-size
+  (t/testing "small font passes through"
+    (let [upload {:filename "a.ttf" :size 1 :path (fs/path "/tmp/penpot/a.ttf") :mtype "font/ttf"}]
+      (t/is (= upload (media.v/check-font-size upload)))))
+  (t/testing "oversized font is rejected"
+    (let [upload {:filename "a.ttf" :size (* 1024 1024 31) :path (fs/path "/tmp/penpot/a.ttf") :mtype "font/ttf"}
+          error  (try (media.v/check-font-size upload) nil
+                      (catch clojure.lang.ExceptionInfo e e))]
+      (t/is (some? error))
+      (t/is (th/ex-of-type? error :restriction))
+      (t/is (th/ex-of-code? error :font-max-file-size-reached)))))
+
+(t/deftest check-upload-path
+  (t/testing "tempfile under /tmp/penpot passes through"
+    (let [path   (th/tempfile "backend_tests/test_files/sample.jpg")
+          upload {:filename "sample.jpg" :size 7923 :path path :mtype "image/jpeg"}]
+      (t/is (= upload (media.v/check-upload-path upload)))))
+  (t/testing "system file outside temp is rejected"
+    (let [upload {:filename "x.png" :size 1 :path (fs/path "/etc/passwd") :mtype "image/png"}
+          error  (try (media.v/check-upload-path upload) nil
+                      (catch clojure.lang.ExceptionInfo e e))]
+      (t/is (some? error))
+      (t/is (th/ex-of-type? error :validation))
+      (t/is (th/ex-of-code? error :params-validation))))
+  (t/testing "missing file is rejected"
+    (let [upload {:filename "x.png" :size 1 :path (fs/path "/tmp/penpot/no-such-file-12345.png") :mtype "image/png"}
+          error  (try (media.v/check-upload-path upload) nil
+                      (catch clojure.lang.ExceptionInfo e e))]
+      (t/is (some? error))
+      (t/is (th/ex-of-type? error :validation))
+      (t/is (th/ex-of-code? error :params-validation)))))

backend/test/backend_tests/rpc_file_thumbnails_test.clj

@@ -921,39 +921,44 @@
       (t/is (= 1 (count rows2)))
       (t/is (nil? (:deleted-at (first rows2)))))))
 
-
-(t/deftest create-file-thumbnail-rejects-forged-media
-  ;; A transit body like {"~:media": {"~:path": ["~#path", "/etc/passwd"]}}
-  ;; decodes to this exact map. Without a multipart request it must fail at
-  ;; params validation, before any file is read. NOTE: plain command! on
-  ;; purpose, a multipart header would make it legitimate.
+(t/deftest rejects-forged-path-on-create-file-thumbnail
   (let [profile (th/create-profile* 1)
         file    (th/create-file* 1 {:profile-id (:id profile)
                                     :project-id (:default-project-id profile)
                                     :is-shared false})
-        out     (th/command! {::th/type :create-file-thumbnail
-                              ::rpc/profile-id (:id profile)
-                              :file-id (:id file)
-                              :revn 0
-                              :media {:filename "evil.jpg"
-                                      :size 123
-                                      :path (fs/path "/etc/passwd")
-                                      :mtype "image/jpeg"}})]
-    (t/is (th/ex-of-code? (:error out) :params-validation))))
+        data    {::th/type :create-file-thumbnail
+                 ::rpc/profile-id (:id profile)
+                 :file-id (:id file)
+                 :revn 1
+                 :media {:filename "x.png"
+                         :size 1
+                         :path (fs/path "/etc/passwd")
+                         :mtype "image/png"}}
+        out     (th/command! data)
+        error   (:error out)]
+    (t/is (nil? (:result out)))
+    (t/is (th/ex-info? error))
+    (t/is (th/ex-of-type? error :validation))
+    (t/is (th/ex-of-code? error :params-validation))
+    (t/is (= 0 (count (th/db-query :file-thumbnail {:file-id (:id file)}))))))
 
-(t/deftest create-file-object-thumbnail-rejects-forged-media
-  ;; Same transit-forgery vector through object thumbnails. NOTE: plain
-  ;; command! on purpose, a multipart header would make it legitimate.
+(t/deftest rejects-forged-path-on-create-file-object-thumbnail
   (let [profile (th/create-profile* 1)
         file    (th/create-file* 1 {:profile-id (:id profile)
                                     :project-id (:default-project-id profile)
                                     :is-shared false})
-        out     (th/command! {::th/type :create-file-object-thumbnail
-                              ::rpc/profile-id (:id profile)
-                              :file-id (:id file)
-                              :object-id "obj"
-                              :media {:filename "evil.jpg"
-                                      :size 123
-                                      :path (fs/path "/etc/passwd")
-                                      :mtype "image/jpeg"}})]
-    (t/is (th/ex-of-code? (:error out) :params-validation))))
+        data    {::th/type :create-file-object-thumbnail
+                 ::rpc/profile-id (:id profile)
+                 :file-id (:id file)
+                 :object-id "test-key-forged"
+                 :media {:filename "x.png"
+                         :size 1
+                         :path (fs/path "/etc/passwd")
+                         :mtype "image/png"}}
+        out     (th/command! data)
+        error   (:error out)]
+    (t/is (nil? (:result out)))
+    (t/is (th/ex-info? error))
+    (t/is (th/ex-of-type? error :validation))
+    (t/is (th/ex-of-code? error :params-validation))
+    (t/is (= 0 (count (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)}))))))

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

@@ -2298,6 +2298,45 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+(defmethod migrate-data "0034-fix-path-content-offset"
+  [data _]
+  ;; A path stores its geometry twice: the box (:selrect and :points) and the
+  ;; drawing (:content), and the box is always derived from the drawing. Some
+  ;; files have component copies whose drawing and box were moved apart, so
+  ;; the drawing renders away from where the sidebar, the layouts and the
+  ;; syncs place the shape. We move the content back onto the box. A path whose drawing
+  ;; has another size than its box is not a displaced drawing, and is left as
+  ;; it is.
+  (let [tolerance 0.1]
+    (letfn [(fix-path [shape]
+              (when (and (cfh/path-shape? shape)
+                         (some? (:selrect shape))
+                         (some? (path.segment/content->selrect (:content shape))))
+                (let [selrect  (:selrect shape)
+                      derived  (:selrect (path/update-geometry shape))
+                      offset   (gpt/subtract (grc/rect->center selrect)
+                                             (grc/rect->center derived))]
+                  (when (and (mth/close? (:width selrect) (:width derived) tolerance)
+                             (mth/close? (:height selrect) (:height derived) tolerance)
+                             (or (> (abs (:x offset)) tolerance)
+                                 (> (abs (:y offset)) tolerance)))
+                    (update shape :content path/move-content offset)))))
+
+            (fix-objects [objects]
+              (reduce-kv (fn [objects id shape]
+                           (if-let [shape (fix-path shape)]
+                             (assoc objects id shape)
+                             objects))
+                         objects
+                         objects))
+
+            (update-container [container]
+              (d/update-when container :objects fix-objects))]
+
+      (-> data
+          (update :pages-index d/update-vals update-container)
+          (d/update-when :components d/update-vals update-container)))))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -2388,4 +2427,5 @@
          "0030-remove-stroke-per-side-attr"
          "0031-migrate-stroke-width-token-attr"
          "0032-fix-children-not-in-parent"
-         "0033-normalize-main-instance-names"]))
+         "0033-normalize-main-instance-names"
+         "0034-fix-path-content-offset"]))

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

@@ -3204,7 +3204,8 @@
                (cond-> (ctsl/grid-layout? obj)
                  (ctsl/remap-grid-cells ids-map))
 
-               (cond-> (ctk/is-variant-container? parent)
+               (cond-> (and (ctk/is-variant-container? parent)
+                            (ctk/main-instance? obj))
                  (assoc :variant-id parent-id))
 
                (cond-> (and (ctk/is-variant? obj) (not (ctk/is-variant-container? parent)))

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

@@ -10,6 +10,7 @@
    [app.common.data.macros :as dm]
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cfh]
+   [app.common.files.shapes-helpers :as cfsh]
    [app.common.geom.shapes :as gsh]
    [app.common.logic.variant-properties :as clvp]
    [app.common.types.component :as ctk]
@@ -450,6 +451,18 @@
      [all-parents changes])))
 
 
+(defn- find-empty-variant-containers
+  [objects excluded-parent-id ids parent-ids]
+  (let [ids (set ids)]
+    (reduce (fn [to-delete candidate-id]
+              (let [parent (get objects candidate-id)]
+                (if (and (ctk/is-variant-container? parent)
+                         (empty? (remove ids (:shapes parent))))
+                  (conj to-delete (:id parent))
+                  to-delete)))
+            #{}
+            (remove #(= % excluded-parent-id) parent-ids))))
+
 (defn generate-relocate
   [changes parent-id to-index ids & {:keys [cell ignore-parents?]}]
   (let [objects     (pcb/get-objects changes)
@@ -553,128 +566,146 @@
 
 
         ;; Parents that are a variant-container that becomes empty
-        empty-variant-cont (reduce
-                            (fn [to-delete parent-id]
-                              (let [parent (get objects parent-id)]
-                                (if (and (ctk/is-variant-container? parent)
-                                         (empty? (remove (set ids) (:shapes parent))))
-                                  (conj to-delete (:id parent))
-                                  to-delete)))
-                            #{}
-                            (remove #(= % parent-id) all-parents))]
+        empty-variant-cont (find-empty-variant-containers objects parent-id ids all-parents)]
 
-    (-> changes
-        ;; Remove layout-item properties and tokens when moving a shape outside a layout
-        (cond-> (not (ctl/any-layout? parent))
-          (-> (pcb/update-shapes ids ctl/remove-layout-item-data)
-              (pcb/update-shapes ids cto/unapply-layout-item-tokens)))
+    (if (and (ctk/is-variant-container? parent)
+             (not (every? ctk/main-instance? shapes)))
+      changes
+      (-> changes
+          ;; Remove layout-item properties and tokens when moving a shape outside a layout
+          (cond-> (not (ctl/any-layout? parent))
+            (-> (pcb/update-shapes ids ctl/remove-layout-item-data)
+                (pcb/update-shapes ids cto/unapply-layout-item-tokens)))
 
-        ;; Remove the hide in viewer flag
-        (cond-> (and (not= uuid/zero parent-id) (cfh/frame-shape? parent))
-          (pcb/update-shapes ids #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true))))
+          ;; Remove the hide in viewer flag
+          (cond-> (and (not= uuid/zero parent-id) (cfh/frame-shape? parent))
+            (pcb/update-shapes ids #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true))))
 
-        ;; Remove the swap slots if it is moving to a different component
-        (pcb/update-shapes
-         child-heads-ids
-         (fn [shape]
-           (cond-> shape
-             (not= component-main-parent (ctn/find-component-main objects shape false))
-             (ctk/remove-swap-slot))))
+          ;; Remove the swap slots if it is moving to a different component
+          (pcb/update-shapes
+           child-heads-ids
+           (fn [shape]
+             (cond-> shape
+               (not= component-main-parent (ctn/find-component-main objects shape false))
+               (ctk/remove-swap-slot))))
 
-        ;; Remove component-root property when moving a shape inside a component
-        (cond-> (ctn/get-instance-root objects parent)
-          (pcb/update-shapes children-ids #(dissoc % :component-root)))
+          ;; Remove component-root property when moving a shape inside a component
+          (cond-> (ctn/get-instance-root objects parent)
+            (pcb/update-shapes children-ids #(dissoc % :component-root)))
 
-        ;; Add component-root property when moving a component outside a component
-        (cond-> (not (ctn/get-instance-root objects parent))
-          (pcb/update-shapes child-heads-ids #(assoc % :component-root true)))
+          ;; Add component-root property when moving a component outside a component
+          (cond-> (not (ctn/get-instance-root objects parent))
+            (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))
-          (clvp/generate-make-shapes-no-variant variant-shapes))
+          ;; Remove variant info and rename when moving outside a variant-container
+          (cond-> (not (ctk/is-variant-container? parent))
+            (clvp/generate-make-shapes-no-variant variant-shapes))
 
-        ;; Add variant info and rename when moving into a different variant-container
-        (cond-> (ctk/is-variant-container? parent)
-          (clvp/generate-make-shapes-variant child-heads parent))
+          ;; Add variant info and rename when moving into a different variant-container
+          (cond-> (ctk/is-variant-container? parent)
+            (clvp/generate-make-shapes-variant child-heads parent))
 
-        ;; Move the shapes
-        (pcb/change-parent parent-id
-                           shapes
-                           to-index)
+          ;; Move the shapes
+          (pcb/change-parent parent-id
+                             shapes
+                             to-index)
 
-        ;; Remove empty groups
-        (pcb/remove-objects groups-to-delete)
+          ;; Remove empty groups
+          (pcb/remove-objects groups-to-delete)
 
-        ;; Unmask groups whose mask have moved outside
-        (pcb/update-shapes groups-to-unmask
-                           (fn [shape]
-                             (assoc shape :masked-group false)))
+          ;; Unmask groups whose mask have moved outside
+          (pcb/update-shapes groups-to-unmask
+                             (fn [shape]
+                               (assoc shape :masked-group false)))
 
-        ;; Detach shapes moved out of their component
-        (pcb/update-shapes shapes-to-detach ctk/detach-shape)
+          ;; Detach shapes moved out of their component
+          (pcb/update-shapes shapes-to-detach ctk/detach-shape)
 
-        ;; Make non root a component moved inside another one
-        (pcb/update-shapes shapes-to-deroot
-                           (fn [shape]
-                             (assoc shape :component-root nil)))
+          ;; Make non root a component moved inside another one
+          (pcb/update-shapes shapes-to-deroot
+                             (fn [shape]
+                               (assoc shape :component-root nil)))
 
-        ;; Make root a subcomponent moved outside its parent component
-        (pcb/update-shapes shapes-to-reroot
-                           (fn [shape]
-                             (assoc shape :component-root true)))
+          ;; Make root a subcomponent moved outside its parent component
+          (pcb/update-shapes shapes-to-reroot
+                             (fn [shape]
+                               (assoc shape :component-root true)))
 
-        ;; Reset constraints depending on the new parent
-        (pcb/update-shapes ids
-                           (fn [shape]
-                             (let [frame-id    (if (= (:type parent) :frame)
-                                                 (:id parent)
-                                                 (:frame-id parent))
-                                   moved-shape (assoc shape
-                                                      :parent-id parent-id
-                                                      :frame-id frame-id)]
-                               (assoc shape
-                                      :constraints-h (gsh/default-constraints-h moved-shape)
-                                      :constraints-v (gsh/default-constraints-v moved-shape))))
-                           {:ignore-touched true})
+          ;; Reset constraints depending on the new parent
+          (pcb/update-shapes ids
+                             (fn [shape]
+                               (let [frame-id    (if (= (:type parent) :frame)
+                                                   (:id parent)
+                                                   (:frame-id parent))
+                                     moved-shape (assoc shape
+                                                        :parent-id parent-id
+                                                        :frame-id frame-id)]
+                                 (assoc shape
+                                        :constraints-h (gsh/default-constraints-h moved-shape)
+                                        :constraints-v (gsh/default-constraints-v moved-shape))))
+                             {:ignore-touched true})
 
-        ;; Fix the sizing when moving a shape
-        (pcb/update-shapes parents
-                           (fn [parent]
-                             (if (ctl/flex-layout? parent)
-                               (cond-> parent
-                                 (ctl/change-h-sizing? (:id parent) objects (:shapes parent))
-                                 (assoc :layout-item-h-sizing :fix)
+          ;; Fix the sizing when moving a shape
+          (pcb/update-shapes parents
+                             (fn [parent]
+                               (if (ctl/flex-layout? parent)
+                                 (cond-> parent
+                                   (ctl/change-h-sizing? (:id parent) objects (:shapes parent))
+                                   (assoc :layout-item-h-sizing :fix)
 
-                                 (ctl/change-v-sizing? (:id parent) objects (:shapes parent))
-                                 (assoc :layout-item-v-sizing :fix))
-                               parent)))
+                                   (ctl/change-v-sizing? (:id parent) objects (:shapes parent))
+                                   (assoc :layout-item-v-sizing :fix))
+                                 parent)))
 
-        ;; Change the grid cell in a grid layout
-        (cond-> (ctl/grid-layout? objects parent-id)
-          (-> (pcb/update-shapes
-               [parent-id]
-               (fn [frame objects]
-                 (let [[row column] cell]
-                   (-> frame
-                       ;; Assign the cell when pushing into a specific grid cell
-                       (cond-> (some? cell)
-                         (-> (ctl/free-cell-shapes ids)
-                             (ctl/push-into-cell ids row column)
-                             (ctl/assign-cells objects)))
-                       (ctl/assign-cell-positions objects))))
-               {:with-objects? true})
-              (pcb/reorder-grid-children [parent-id])))
+          ;; Change the grid cell in a grid layout
+          (cond-> (ctl/grid-layout? objects parent-id)
+            (-> (pcb/update-shapes
+                 [parent-id]
+                 (fn [frame objects]
+                   (let [[row column] cell]
+                     (-> frame
+                         ;; Assign the cell when pushing into a specific grid cell
+                         (cond-> (some? cell)
+                           (-> (ctl/free-cell-shapes ids)
+                               (ctl/push-into-cell ids row column)
+                               (ctl/assign-cells objects)))
+                         (ctl/assign-cell-positions objects))))
+                 {:with-objects? true})
+                (pcb/reorder-grid-children [parent-id])))
 
-        ;; If parent locked, lock the added shapes
-        (cond-> (:blocked parent)
-          (pcb/update-shapes ids #(assoc % :blocked true)))
+          ;; If parent locked, lock the added shapes
+          (cond-> (:blocked parent)
+            (pcb/update-shapes ids #(assoc % :blocked true)))
 
-        ;; Resize parent containers that need to
-        (pcb/resize-parents parents)
+          ;; Resize parent containers that need to
+          (pcb/resize-parents parents)
 
-        ;; Remove parents when are a variant-container that becomes empty
-        (cond-> (seq empty-variant-cont)
-          (#(second (generate-delete-shapes % empty-variant-cont {})))))))
+          ;; Remove parents when are a variant-container that becomes empty
+          (cond-> (seq empty-variant-cont)
+            (#(second (generate-delete-shapes % empty-variant-cont {}))))))))
+
+(defn generate-move-shapes-into-frame
+  "Reparent `shapes` into `frame-id`, stripping variant records when a
+   variant main leaves its container. The builder must already have
+   objects and library data."
+  [changes frame-id shapes objects remove-layout-data?]
+  (let [parent-id          (dm/get-in objects [frame-id :parent-id])
+        ids                (remove #(= % parent-id) shapes)
+        to-move            (->> ids
+                                (map (d/getf objects))
+                                (filter some?))
+        new-parent         (get objects frame-id)
+        variant-shapes     (filter ctk/is-variant? to-move)
+        all-parents        (into #{frame-id} (map #(cfh/get-parent-id objects %)) ids)
+        empty-variant-cont (find-empty-variant-containers objects frame-id ids all-parents)]
+    (if (empty? to-move)
+      changes
+      (-> changes
+          (cond-> (not (ctk/is-variant-container? new-parent))
+            (clvp/generate-make-shapes-no-variant variant-shapes))
+          (cfsh/prepare-move-shapes-into-frame frame-id shapes objects remove-layout-data?)
+          (cond-> (seq empty-variant-cont)
+            (#(second (generate-delete-shapes % empty-variant-cont {}))))))))
 
 (defn change-show-in-viewer
   [shape hide?]

common/src/app/common/logic/variant_properties.cljc

@@ -61,15 +61,18 @@
   [changes component-id pos value]
   (if-let [value (ctv/prepare-property-value value)]
     (let [data      (pcb/get-library-data changes)
+          objects   (pcb/get-objects changes)
           component (ctcl/get-component data component-id true)
-          main-id   (:main-instance-id component)
-          name      (-> (:variant-properties component)
-                        (update pos assoc :value value)
-                        ctv/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))))
+          main-id   (:main-instance-id component)]
+      (if (contains? objects main-id)
+        (let [name (-> (:variant-properties component)
+                       (update pos assoc :value value)
+                       ctv/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))))
+        changes))
     changes))
 
 

common/test/common_tests/files_migrations_0034_test.cljc

@@ -0,0 +1,116 @@
+;; 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 SUBSIDIARY SL
+
+(ns common-tests.files-migrations-0034-test
+  (:require
+   [app.common.files.migrations :as cfm]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.shapes :as gsh]
+   [app.common.math :as mth]
+   [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as segment]
+   [app.common.types.shape :as cts]
+   [app.common.uuid :as uuid]
+   [clojure.test :as t]))
+
+;; 0034-fix-path-content-offset
+;; A path whose drawing (:content) was moved apart from its box
+;; (:selrect and :points) gets its content moved back onto the box.
+
+(def ^:private migration "0034-fix-path-content-offset")
+
+(defn- triangle
+  [x0 y0]
+  [{:command :move-to :params {:x x0 :y y0}}
+   {:command :line-to :params {:x (+ x0 14) :y y0}}
+   {:command :line-to :params {:x (+ x0 7) :y (+ y0 14)}}
+   {:command :close-path}])
+
+(defn- make-path
+  [shape-id x0 y0]
+  (cts/setup-shape {:id shape-id :type :path :content (triangle x0 y0)}))
+
+(defn- rotate
+  [shape angle]
+  (gsh/transform-shape shape (ctm/rotation-modifiers shape (gsh/shape->center shape) angle)))
+
+(defn- displace-content
+  [shape delta]
+  (update shape :content path/move-content delta))
+
+(defn- migrate-shape
+  [shape]
+  (let [page-id (uuid/next)
+        data    {:pages-index {page-id {:objects {(:id shape) shape}}}}
+        data'   (cfm/migrate-data data migration)]
+    (get-in data' [:pages-index page-id :objects (:id shape)])))
+
+(defn- content-matches-box?
+  [shape]
+  (let [derived (path/update-geometry shape)]
+    (and (every? true? (map gpt/close? (:points shape) (:points derived)))
+         (every? #(mth/close? (get (:selrect shape) %) (get (:selrect derived) %))
+                 [:x :y :width :height]))))
+
+(t/deftest migration-0034-moves-displaced-content-onto-its-box
+  (let [shape   (make-path (uuid/next) 1 1)
+        broken  (displace-content shape (gpt/point 0 -182))
+        shape'  (migrate-shape broken)]
+
+    (t/is (not (content-matches-box? broken)) "the fixture is broken")
+    (t/is (content-matches-box? shape') "content back onto the box")
+    (t/is (= (:selrect broken) (:selrect shape')) "box unchanged")
+    (t/is (= (:points broken) (:points shape')) "points unchanged")
+    (t/is (= (segment/content->selrect (:content shape))
+             (segment/content->selrect (:content shape')))
+          "content where it was before being displaced")))
+
+(t/deftest migration-0034-moves-displaced-content-of-a-rotated-path
+  (let [shape   (rotate (make-path (uuid/next) 100 100) 30)
+        broken  (displace-content shape (gpt/point 25 -40))
+        shape'  (migrate-shape broken)]
+
+    (t/is (not (gmt/close? (gmt/matrix) (:transform shape))) "the fixture is rotated")
+    (t/is (not (content-matches-box? broken)) "the fixture is broken")
+    (t/is (content-matches-box? shape') "content back onto the box")
+    (t/is (= (:selrect broken) (:selrect shape')) "box unchanged")
+    (t/is (= (:transform broken) (:transform shape')) "rotation unchanged")))
+
+(t/deftest migration-0034-keeps-paths-whose-content-matches-the-box
+  (let [shape  (make-path (uuid/next) 10 20)
+        small  (displace-content shape (gpt/point 0.05 0))]
+
+    (t/is (identical? shape (migrate-shape shape)) "consistent path untouched")
+    (t/is (identical? small (migrate-shape small)) "float noise untouched")))
+
+(t/deftest migration-0034-keeps-paths-whose-content-has-another-size
+  (let [shape  (make-path (uuid/next) 0 0)
+        bigger (assoc shape :content (path/content [{:command :move-to :params {:x 40 :y 0}}
+                                                    {:command :line-to :params {:x 70 :y 0}}
+                                                    {:command :line-to :params {:x 55 :y 30}}
+                                                    {:command :close-path}]))]
+
+    (t/is (identical? bigger (migrate-shape bigger)) "size mismatch untouched")))
+
+(t/deftest migration-0034-ignores-shapes-other-than-paths
+  (let [shape-id (uuid/next)
+        rect     (cts/setup-shape {:id shape-id :type :rect :x 0 :y 0 :width 10 :height 10})]
+    (t/is (identical? rect (migrate-shape rect)))))
+
+(t/deftest migration-0034-fixes-paths-inside-components
+  (let [shape        (make-path (uuid/next) 1 1)
+        broken       (displace-content shape (gpt/point 0 109))
+        component-id (uuid/next)
+        data         {:pages-index {}
+                      :components  {component-id {:id component-id
+                                                  :deleted true
+                                                  :objects {(:id broken) broken}}}}
+        data'        (cfm/migrate-data data migration)
+        shape'       (get-in data' [:components component-id :objects (:id broken)])]
+
+    (t/is (content-matches-box? shape') "deleted component content fixed")))

common/test/common_tests/logic/variants_reparent_test.cljc

@@ -0,0 +1,316 @@
+;; 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 SUBSIDIARY SL
+
+(ns common-tests.logic.variants-reparent-test
+  (:require
+   [app.common.files.changes-builder :as pcb]
+   [app.common.logic.shapes :as cls]
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.compositions :as tho]
+   [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]
+   [app.common.types.component :as ctk]
+   [clojure.test :as t]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+(defn- relocate
+  [file parent-id ids & {:keys [to-index] :or {to-index 0}}]
+  (let [page (thf/current-page file)]
+    (-> (pcb/empty-changes nil)
+        (pcb/with-page-id (:id page))
+        (pcb/with-objects (:objects page))
+        (pcb/with-library-data (:data file))
+        (cls/generate-relocate parent-id to-index (set ids)))))
+
+(defn- move-into-frame
+  [file frame-id ids]
+  (let [page    (thf/current-page file)
+        objects (:objects page)]
+    (-> (pcb/empty-changes nil (:id page))
+        (pcb/with-objects objects)
+        (pcb/with-library-data (:data file))
+        (cls/generate-move-shapes-into-frame frame-id ids objects true))))
+
+(defn- property-names
+  [component]
+  (mapv :name (:variant-properties component)))
+
+(defn- strip-component-times
+  "Undo restamps :modified-at on components when mains are updated.
+   Compare file data without that clock."
+  [data]
+  (update data :components update-vals #(dissoc % :modified-at)))
+
+(t/deftest test-relocate-plain-shape-onto-container-is-rejected
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-rect :rect1))
+        container  (ths/get-shape file :v01)
+        rect       (ths/get-shape file :rect1)
+        children   (:shapes container)
+        changes    (relocate file (:id container) [(:id rect)])
+        file'      (thf/apply-changes file changes)
+        rect'      (ths/get-shape file' :rect1)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (empty? (:redo-changes changes)))
+    (t/is (= (:parent-id rect) (:parent-id rect')))
+    (t/is (= (:constraints-h rect) (:constraints-h rect')))
+    (t/is (= (:constraints-v rect) (:constraints-v rect')))
+    (t/is (= children (:shapes container')))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-component-copy-onto-container-is-rejected
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-simple-component-with-copy :c03 :m03 :r03 :copy03))
+        container  (ths/get-shape file :v01)
+        copy       (ths/get-shape file :copy03)
+        comp       (thc/get-component file :c03)
+        children   (:shapes container)
+        changes    (relocate file (:id container) [(:id copy)])
+        file'      (thf/apply-changes file changes)
+        copy'      (ths/get-shape file' :copy03)
+        comp'      (thc/get-component file' :c03)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (empty? (:redo-changes changes)))
+    (t/is (= (:parent-id copy) (:parent-id copy')))
+    (t/is (nil? (:variant-id copy')))
+    (t/is (= (:variant-id comp) (:variant-id comp')))
+    (t/is (= (:variant-properties comp) (:variant-properties comp')))
+    (t/is (= children (:shapes container')))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-mixed-selection-onto-container-is-rejected
+  (let [file      (-> (thf/sample-file :file1)
+                      (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                      (tho/add-rect :rect1)
+                      (tho/add-simple-component :c03 :m03 :r03))
+        container (ths/get-shape file :v01)
+        rect      (ths/get-shape file :rect1)
+        main      (ths/get-shape file :m03)
+        changes   (relocate file (:id container) [(:id rect) (:id main)])
+        file'     (thf/apply-changes file changes)
+        rect'     (ths/get-shape file' :rect1)
+        main'     (ths/get-shape file' :m03)]
+
+    (t/is (empty? (:redo-changes changes)))
+    (t/is (= (:parent-id rect) (:parent-id rect')))
+    (t/is (= (:parent-id main) (:parent-id main')))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-main-into-container-becomes-variant
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-simple-component :c03 :m03 :r03))
+        container  (ths/get-shape file :v01)
+        main       (ths/get-shape file :m03)
+        sibling    (thc/get-component file :c01)
+        changes    (relocate file (:id container) [(:id main)])
+        file'      (thf/apply-changes file changes)
+        file''     (thf/apply-undo-changes file' changes)
+        main'      (ths/get-shape file' :m03)
+        comp'      (thc/get-component file' :c03)
+        sibling'   (thc/get-component file' :c01)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (= (:id container') (:parent-id main')))
+    (t/is (= (:id container') (:variant-id main')))
+    (t/is (= (:id container') (:variant-id comp')))
+    (t/is (some? (:variant-name main')))
+    (t/is (= (property-names sibling') (property-names comp')))
+    (t/is (= (property-names sibling) (property-names sibling')))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file''))))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-reorder-mains-does-not-rebuild-properties
+  (let [file      (-> (thf/sample-file :file1)
+                      (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        container (ths/get-shape file :v01)
+        m01       (ths/get-shape file :m01)
+        m02       (ths/get-shape file :m02)
+        c01       (thc/get-component file :c01)
+        c02       (thc/get-component file :c02)
+        changes   (relocate file (:id container) [(:id m01)] :to-index 0)
+        file'     (thf/apply-changes file changes)
+        file''    (thf/apply-undo-changes file' changes)
+        m01'      (ths/get-shape file' :m01)
+        m02'      (ths/get-shape file' :m02)
+        c01'      (thc/get-component file' :c01)
+        c02'      (thc/get-component file' :c02)]
+
+    (t/is (= (:variant-name m01) (:variant-name m01')))
+    (t/is (= (:variant-name m02) (:variant-name m02')))
+    (t/is (= (:variant-properties c01) (:variant-properties c01')))
+    (t/is (= (:variant-properties c02) (:variant-properties c02')))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file''))))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-all-mains-within-container-keeps-container
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        container  (ths/get-shape file :v01)
+        m01        (ths/get-shape file :m01)
+        m02        (ths/get-shape file :m02)
+        changes    (relocate file (:id container) [(:id m01) (:id m02)])
+        file'      (thf/apply-changes file changes)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (= (:id container) (:id container')))
+    (t/is (= (set (:shapes container)) (set (:shapes container'))))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-main-out-of-container-clears-variant-data
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-frame :board1))
+        board      (ths/get-shape file :board1)
+        m01        (ths/get-shape file :m01)
+        changes    (relocate file (:id board) [(:id m01)])
+        file'      (thf/apply-changes file changes)
+        file''     (thf/apply-undo-changes file' changes)
+        m01'       (ths/get-shape file' :m01)
+        c01'       (thc/get-component file' :c01)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (= (:id board) (:parent-id m01')))
+    (t/is (nil? (:variant-id m01')))
+    (t/is (nil? (:variant-name m01')))
+    (t/is (nil? (:variant-id c01')))
+    (t/is (nil? (:variant-properties c01')))
+    (t/is (some? container'))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file''))))
+    (thf/validate-file! file')))
+
+(t/deftest test-relocate-last-mains-out-deletes-empty-container
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-frame :board1))
+        board      (ths/get-shape file :board1)
+        m01        (ths/get-shape file :m01)
+        m02        (ths/get-shape file :m02)
+        changes    (relocate file (:id board) [(:id m01) (:id m02)])
+        file'      (thf/apply-changes file changes)
+        file''     (thf/apply-undo-changes file' changes)
+        container' (ths/get-shape file' :v01)
+        m01'       (ths/get-shape file' :m01)
+        m02'       (ths/get-shape file' :m02)
+        c01'       (thc/get-component file' :c01)
+        c02'       (thc/get-component file' :c02)]
+
+    (t/is (nil? container'))
+    (t/is (some? m01'))
+    (t/is (some? m02'))
+    (t/is (= (:id board) (:parent-id m01')))
+    (t/is (= (:id board) (:parent-id m02')))
+    (t/is (nil? (:variant-id m01')))
+    (t/is (nil? (:variant-id m02')))
+    (t/is (nil? (:variant-name m01')))
+    (t/is (nil? (:variant-name m02')))
+    (t/is (some? c01'))
+    (t/is (some? c02'))
+    (t/is (nil? (:variant-id c01')))
+    (t/is (nil? (:variant-id c02')))
+    (t/is (nil? (:variant-properties c01')))
+    (t/is (nil? (:variant-properties c02')))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file''))))
+    (thf/validate-file! file')))
+
+(t/deftest test-board-draw-strips-variant-data-when-main-leaves
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-frame :board1))
+        board      (ths/get-shape file :board1)
+        m01        (ths/get-shape file :m01)
+        changes    (move-into-frame file (:id board) [(:id m01)])
+        file'      (thf/apply-changes file changes)
+        file''     (thf/apply-undo-changes file' changes)
+        m01'       (ths/get-shape file' :m01)
+        c01'       (thc/get-component file' :c01)
+        container' (ths/get-shape file' :v01)]
+
+    (t/is (= (:id board) (:parent-id m01')))
+    (t/is (nil? (:variant-id m01')))
+    (t/is (nil? (:variant-name m01')))
+    (t/is (nil? (:variant-id c01')))
+    (t/is (nil? (:variant-properties c01')))
+    (t/is (some? container'))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file''))))
+    (thf/validate-file! file')))
+
+(t/deftest test-board-draw-last-main-deletes-empty-container
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-frame :board1))
+        board      (ths/get-shape file :board1)
+        m01        (ths/get-shape file :m01)
+        m02        (ths/get-shape file :m02)
+        file*      (thf/apply-changes file (move-into-frame file (:id board) [(:id m01)]))
+        changes    (move-into-frame file* (:id board) [(:id m02)])
+        file'      (thf/apply-changes file* changes)
+        container' (ths/get-shape file' :v01)
+        m01'       (ths/get-shape file' :m01)
+        m02'       (ths/get-shape file' :m02)
+        c01'       (thc/get-component file' :c01)
+        c02'       (thc/get-component file' :c02)]
+
+    (t/is (nil? container'))
+    (t/is (some? m01'))
+    (t/is (some? m02'))
+    (t/is (= (:id board) (:parent-id m01')))
+    (t/is (= (:id board) (:parent-id m02')))
+    (t/is (nil? (:variant-id m01')))
+    (t/is (nil? (:variant-id m02')))
+    (t/is (nil? (:variant-name m01')))
+    (t/is (nil? (:variant-name m02')))
+    (t/is (some? c01'))
+    (t/is (some? c02'))
+    (t/is (nil? (:variant-id c01')))
+    (t/is (nil? (:variant-id c02')))
+    (t/is (nil? (:variant-properties c01')))
+    (t/is (nil? (:variant-properties c02')))
+    (thf/validate-file! file')))
+
+(t/deftest test-board-draw-undo-restores-emptied-container
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02)
+                       (tho/add-frame :board1))
+        board      (ths/get-shape file :board1)
+        m01        (ths/get-shape file :m01)
+        m02        (ths/get-shape file :m02)
+        changes*   (move-into-frame file (:id board) [(:id m01)])
+        file*      (thf/apply-changes file changes*)
+        changes    (move-into-frame file* (:id board) [(:id m02)])
+        file'      (thf/apply-changes file* changes)
+        file''     (thf/apply-undo-changes file' changes)
+        file'''    (thf/apply-undo-changes file'' changes*)]
+
+    (t/is (= (strip-component-times (:data file*))
+             (strip-component-times (:data file''))))
+    (t/is (= (strip-component-times (:data file))
+             (strip-component-times (:data file'''))))))
+
+(t/deftest test-duplicate-variant-main-keeps-variant-id
+  (let [file       (-> (thf/sample-file :file1)
+                       (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        container  (ths/get-shape file :v01)
+        file'      (tho/duplicate-shape file :m01)
+        objects'   (:objects (thf/current-page file'))
+        variant-mains (->> (vals objects')
+                           (filter ctk/main-instance?)
+                           (filter #(= (:id container) (:variant-id %))))]
+
+    (t/is (= 3 (count variant-mains)))
+    (thf/validate-file! file')))

common/test/common_tests/logic/variants_test.cljc

@@ -511,3 +511,55 @@
     (thf/validate-file! file')
     (t/is (some? new-shape'))
     (t/is (not= (:parent-id new-shape') (:id container)))))
+
+(defn- two-property-file-with-other-page
+  []
+  (-> (thf/sample-file :file1 :page-label :page1)
+      (thv/add-variant-two-properties :v01 :c01 :m01 :c02 :m02)
+      (thf/add-sample-page :page2)))
+
+(t/deftest test-update-property-value-skips-when-main-not-in-objects
+  (let [file    (two-property-file-with-other-page)
+        other   (thf/current-page file)
+        comp01  (thc/get-component file :c01)
+        main    (ths/get-shape file :m01 :page-label :page1)
+        before  (:variant-properties comp01)
+        label   (:variant-name main)
+
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id other))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects other))
+                    (clvp/generate-update-property-value (:id comp01) 1 "crítica"))
+
+        file'   (thf/apply-changes file changes)
+        comp01' (thc/get-component file' :c01)
+        main'   (ths/get-shape file' :m01 :page-label :page1)]
+
+    (thf/validate-file! file')
+    (t/is (empty? (:redo-changes changes)))
+    (t/is (= before (:variant-properties comp01')))
+    (t/is (= label (:variant-name main')))))
+
+(t/deftest test-update-property-value-writes-main-page-and-chains
+  (let [file     (two-property-file-with-other-page)
+        mains    (thf/get-page file :page1)
+        comp01   (thc/get-component file :c01)
+
+        changes  (-> (pcb/empty-changes nil)
+                     (pcb/with-page-id (:id mains))
+                     (pcb/with-library-data (:data file))
+                     (pcb/with-objects (:objects mains))
+                     (clvp/generate-update-property-value (:id comp01) 0 "active")
+                     (clvp/generate-update-property-value (:id comp01) 1 "crítica"))
+
+        file'    (thf/apply-changes file changes)
+        comp01'  (thc/get-component file' :c01)
+        main'    (ths/get-shape file' :m01 :page-label :page1)
+        props'   (:variant-properties comp01')]
+
+    (thf/validate-file! file')
+    (t/is (= "active" (-> props' first :value)))
+    (t/is (= "crítica" (-> props' second :value)))
+    (t/is (= (ctv/properties-to-name props') (:variant-name main')))
+    (t/is (= "active, crítica" (:variant-name main')))))

common/test/common_tests/runner.cljc

@@ -22,6 +22,7 @@
    [common-tests.files-changes-test]
    [common-tests.files-migrations-0025-test]
    [common-tests.files-migrations-0026-test]
+   [common-tests.files-migrations-0034-test]
    [common-tests.files-migrations-test]
    [common-tests.files.comp-processors-test]
    [common-tests.files.helpers-test]
@@ -77,6 +78,7 @@
    [common-tests.logic.text-touched-test]
    [common-tests.logic.token-apply-test]
    [common-tests.logic.token-test]
+   [common-tests.logic.variants-reparent-test]
    [common-tests.logic.variants-switch-test]
    [common-tests.logic.variants-test]
    [common-tests.math-test]
@@ -129,6 +131,7 @@
    'common-tests.files-changes-test
    'common-tests.files-migrations-0025-test
    'common-tests.files-migrations-0026-test
+   'common-tests.files-migrations-0034-test
    'common-tests.files-migrations-test
    'common-tests.files.comp-processors-test
    'common-tests.files.helpers-test
@@ -184,6 +187,7 @@
    'common-tests.logic.text-touched-test
    'common-tests.logic.token-apply-test
    'common-tests.logic.token-test
+   'common-tests.logic.variants-reparent-test
    'common-tests.logic.variants-switch-test
    'common-tests.logic.variants-test
    'common-tests.math-test

docs/technical-guide/integration.md

@@ -67,13 +67,13 @@ Personal access tokens function like an alternative to our login/password authen
 <p class="advice"><strong>Important:</strong> Treat your access tokens like passwords as they provide access to our account.</p>
 
 ### Manage access tokens
-In Penpot, access tokens are configured at user account level. To manage your access tokens, go to Your account > Access tokens.
+In Penpot, access tokens are configured at user account level. To manage your access tokens, go to Your account > Integrations. You'll find them in the Personal access tokens section.
 
 ![Access tokens](/img/tech-guide/access-tokens.webp)
 
 ### Generate access tokens
 
-1. Press the "Generate new token" button.
+1. Press the "Create new access token" button.
 
 ![Creating token](/img/tech-guide/access-tokens-create-1.webp)
 
@@ -83,7 +83,7 @@ In Penpot, access tokens are configured at user account level. To manage your ac
 
 ![Token expiration](/img/tech-guide/access-tokens-create-2.webp)
 
-4. Once you're happy with the name and the expiration date, press "Create token". At this step you will be able to copy the token to your clipboard.
+4. Once you're happy with the name and the expiration date, press "Create access token". At this step you will be able to copy the token to your clipboard. Keep it somewhere safe: once you close the dialog you will not be able to see it again.
 
 ![Token created](/img/tech-guide/access-tokens-create-3.webp)
 

docs/user-guide/account-teams/your-account.njk

@@ -76,6 +76,6 @@ desc: Learn how to import and export files in Penpot, the free, open-source desi
 <h3 id="your-account-accesstokens">Access tokens
   <a class="direct-link" href="#your-account-accesstokens">#</a>
 </h3>
-<p>At the <strong>Asset tokens</strong> section you can manage your access tokens. <a href="https://help.penpot.app/technical-guide/integration/#access-tokens" target="_blank">Read more about access tokens here</a>.</p>
+<p>At the <strong>Integrations</strong> section, under <strong>Personal access tokens</strong>, you can manage your access tokens. <a href="https://help.penpot.app/technical-guide/integration/#access-tokens" target="_blank">Read more about access tokens here</a>.</p>
 
 

docs/user-guide/design-systems/libraries.njk

@@ -24,7 +24,7 @@ desc: Use Penpot's libraries for reusable design elements! Learn to create, mana
 <p>There are two ways to publish a library:</p>
 <ul>
   <li>Using the file main menu.</li>
-  <li>From the libraries panel, that you can launch by clicking on the "Libraries" button that is found at the assets tab.</li>
+  <li>From the libraries panel, that you can launch from the button at the top of the assets tab. It reads "Add library" when the file has no connected libraries and "Manage library" when it has.</li>
 </ul>
 <figure>
   <img src="/img/libraries/libraries-publish-menu.webp" alt="Publish library">

docs/user-guide/designing/workspace-basics.njk

@@ -25,7 +25,7 @@ desc: Master Penpot's workspace basics! Learn interface navigation, zoom tools,
 
 
 <h2 id="workspace-menu">The menu</h2>
-<p>There's a main menu at the workspace where you will find groups with all the actions that you can do at file level. File, View, Edit, Preferences and Help.</p>
+<p>There's a main menu at the workspace where you will find groups with all the actions that you can do at file level. File, Edit, View, Preferences, Plugins and Help &amp; info. If the MCP server is enabled, you'll also find an MCP server entry.</p>
 <figure>
   <img src="/img/workspace-basics/main-menu.webp" alt="Main menu" />
 </figure>