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

2026-08-27 15:19:49 +00:00 · 2026-08-27 11:54:55 +02:00 · 2026-08-27 11:54:55 +02:00 · a3feb4ef3b
commit a3feb4ef3b
parent 46fdec5c0f c9a2b8f12f
8 changed files with 397 additions and 10 deletions
--- a/backend/resources/app/templates/debug.tmpl
+++ b/backend/resources/app/templates/debug.tmpl
@ -190,6 +190,20 @@ Debug Main Page
        </div>
      </form>
    </fieldset>
+
+    <fieldset>
+      <legend>Validate file:</legend>
+      <desc>Given an FILE-ID, check the referential integrity.</desc>
+      <form method="get" action="/dbg/actions/file-validate">
+        <div class="row">
+          <input type="text" style="width:300px" name="file-id" placeholder="file-id" />
+        </div>
+        <div class="row">
+          <input type="submit" name="validate" value="Validate" />
+        </div>
+      </form>
+    </fieldset>
+
  </section>
  <section class="widget">
    <fieldset>
@ -222,6 +236,7 @@ Debug Main Page
        </div>
      </form>
    </fieldset>
+
    <fieldset>
      <legend>Import binfile:</legend>
      <desc>Import penpot file in binary format.</desc>
@ -236,6 +251,34 @@ Debug Main Page
        </div>
      </form>
    </fieldset>
+
+    <fieldset>
+      <legend>Repair file:</legend>
+      <desc>Given an FILE-ID, repair the referential integrity errors.
+        <br/>
+        <br/>
+        <b>WARNING: the reparation is not guaranteed and may cause loss of data!</b>
+        <br/>
+        <br/>
+        You may need to give several repair rounds until all errors are cleared.
+      </desc>
+      <form method="get" action="/dbg/actions/file-repair">
+        <div class="row">
+          <input type="text" style="width:300px" name="file-id" placeholder="file-id" />
+        </div>
+        <div class="row">
+          <label for="check-snapshot">Skip snapshot</label>
+          <input id="check-snapshot" type="checkbox" name="skip-snapshot" />
+          <br />
+          <small>
+            A snapshot is made just before the validation, unless skipped. 
+          </small>
+        </div>
+        <div class="row">
+          <input type="submit" name="repair" value="Repair" />
+        </div>
+      </form>
+    </fieldset>
  </section>
 </main>
 {% endblock %}
--- a/backend/src/app/http/debug.clj
+++ b/backend/src/app/http/debug.clj
@ -13,6 +13,9 @@
   [app.common.data :as d]
   [app.common.exceptions :as ex]
   [app.common.features :as cfeat]
+   [app.common.files.changes :as cfc]
+   [app.common.files.repair :as cfr]
+   [app.common.files.validate :as cfv]
   [app.common.logging :as l]
   [app.common.pprint :as pp]
   [app.common.time :as ct]
@ -28,6 +31,7 @@
   [app.rpc.commands.teams :as teams]
   [app.setup :as-alias setup]
   [app.setup.clock :as clock]
+   [app.srepl.helpers :as h]
   [app.srepl.main :as srepl]
   [app.storage :as-alias sto]
   [app.storage.tmp :as tmp]
@ -130,7 +134,7 @@
                  :hint "invalid button"))

      (ex/raise :type :not-found
-                :code :enpty-data
+                :code :empty-data
                :hint "empty response"))))

 (defn- is-file-exists?
@ -484,6 +488,89 @@
        {::yres/status 302
         ::yres/headers {"location" "/dbg"}}))))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; VALIDATE / REPAIR
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- validate-file
+  [cfg {:keys [params] :as request}]
+  (let [file-id  (some-> params :file-id parse-uuid)]
+
+    (when-not file-id
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (db/tx-run! (assoc cfg ::db/rollback true)
+                (fn [cfg]
+                  (let [file (bfc/get-file cfg file-id)
+                        libs (bfc/get-resolved-file-libraries cfg file-id)]
+                    (if file
+                      (let [errors (cfv/validate-file file libs)]
+                        {::yres/status  200
+                         ::yres/headers {"content-type" "text/plain"}
+                         ::yres/body    (if (empty? errors)
+                                          "NO VALIDATION ERRORS FOUND"
+                                          (pp/pprint-str errors))})
+                      (ex/raise :type :not-found
+                                :code :empty-data
+                                :hint "empty response")))))))
+
+(defn- repair-file
+  [cfg {:keys [params] :as request}]
+  (let [file-id        (some-> params :file-id parse-uuid)
+        skip-snapshot? (contains? params :skip-snapshot)
+        profile-id     (:app.http.session/profile-id request)]
+
+    (when-not file-id
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (let [output (StringBuilder.)
+
+          repair-file
+          (fn [file libs _]
+            (let [errors (cfv/validate-file file libs)]
+              (.append output (if (empty? errors)
+                                "NO VALIDATION ERRORS FOUND\n"
+                                (str "VALIDATION ERRORS FOUND:\n"
+                                     (pp/pprint-str errors) "\n")))
+              (if (empty? errors)
+                file
+                (let [changes (cfr/repair-file file libs errors)]
+                  (-> file
+                      (update :revn inc)
+                      (update :data cfc/process-changes changes))))))]
+
+      (add-watch l/log-record ::repair-watcher
+                 (fn [_ _ _ record]
+                   (when (= "app.common.files.repair" (::l/logger record))
+                     (let [props (::l/props record)
+                           hint (get props :hint "")
+                           args (dissoc props :hint)
+                           message (str hint " "
+                                        (when-not (empty? args)
+                                          args)
+                                        "\n")]
+                       (.append output message)))))
+      (try
+        (db/tx-run! cfg
+                    h/process-file!
+                    file-id
+                    repair-file
+                    {::h/with-libraries? true
+                     ::h/validate? false
+                     ::h/profile-id profile-id
+                     ::h/snapshot-label (when-not skip-snapshot? "repair")})
+
+        (.append output "\nREPAIR FINISHED")
+
+        {::yres/status  200
+         ::yres/headers {"content-type" "text/plain"}
+         ::yres/body    (.toString output)}
+
+        (finally
+          (remove-watch l/log-record ::repair-watcher))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; OTHER SMALL VIEWS/HANDLERS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -578,5 +665,7 @@
      {:handler (partial handle-team-features cfg)}]
     ["/file-export" {:handler (partial export-handler cfg)}]
     ["/file-import" {:handler (partial import-handler cfg)}]
-     ["/file-raw-export-import" {:handler (partial raw-export-import-handler cfg)}]]]])
+     ["/file-raw-export-import" {:handler (partial raw-export-import-handler cfg)}]
+     ["/file-validate" {:handler (partial validate-file cfg)}]
+     ["/file-repair" {:handler (partial repair-file cfg)}]]]])

--- a/backend/src/app/srepl/helpers.clj
+++ b/backend/src/app/srepl/helpers.clj
@ -153,7 +153,7 @@

 (defn process-file!
  [system file-id update-fn
-   & {:keys [::snapshot-label ::validate? ::with-libraries?]
+   & {:keys [::profile-id ::snapshot-label ::validate? ::with-libraries?]
      :or {validate? true} :as opts}]
  (let [file  (bfc/get-file system file-id
                            :lock-for-update? true
@ -177,8 +177,9 @@
      (when (string? snapshot-label)
        (fsnap/create! system file
                       {:label snapshot-label
+                        :profile-id profile-id
                        :deleted-at (ct/in-future {:days 30})
-                        :created-by "admin"}))
+                        :created-by "system"}))

      (let [file' (update file' :revn inc)]
        (bfc/update-file! system file' opts)
--- a/backend/src/app/srepl/main.clj
+++ b/backend/src/app/srepl/main.clj
@ -398,10 +398,6 @@
                        (println (sm/humanize-explain explain))
                        (ex/print-throwable cause))))))))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; PROCESSING
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (defn repair-file!
  "Repair the list of errors detected by validation."
  [file-id & {:keys [rollback?] :or {rollback? true} :as options}]
@ -410,6 +406,10 @@
        options (assoc options ::h/with-libraries? true)]
    (db/tx-run! system h/process-file! file-id procs.file-repair/repair-file options)))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PROCESSING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn update-file!
  "Apply a function to the file. Optionally save the changes or not.
  The function receives the decoded and migrated file data."
--- a/common/src/app/common/types/file.cljc
+++ b/common/src/app/common/types/file.cljc
@ -28,7 +28,8 @@
   [app.common.types.shape :as cts]
   [app.common.types.shape-tree :as ctst]
   [app.common.types.text :as txt]
-   [app.common.types.tokens-lib :refer [schema:tokens-lib]]
+   [app.common.types.tokens-lib :as ctob]
+   [app.common.types.tokens-status :as ctos]
   [app.common.types.typographies-list :as ctyl]
   [app.common.types.typography :as cty]
   [app.common.uuid :as uuid]
@ -86,7 +87,9 @@
   [:components {:optional true} schema:components]
   [:typographies {:optional true} schema:typographies]
   [:plugin-data {:optional true} schema:plugin-data]
-   [:tokens-lib {:optional true} schema:tokens-lib]])
+   [:tokens-source {:optional true} ::sm/uuid]                ;; Forward-compat: UUID of external library containing tokens-lib (full support in follow-up PR)
+   [:tokens-lib {:optional true} ctob/schema:tokens-lib]
+   [:tokens-status {:optional true} ctos/schema:tokens-status]])

 (def schema:file-metadata
  [:map {:title "Metadata"}
@ -316,6 +319,7 @@
       (update-objects-tree container f)))))

 ;; Asset helpers
+
 (defn find-component-file
  [file libraries component-file]
  (if (and (some? file) (= component-file (:id file)))
--- a/common/src/app/common/types/tokens_status.cljc
+++ b/common/src/app/common/types/tokens_status.cljc
@ -0,0 +1,147 @@
+;; 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 app.common.types.tokens-status
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as c.json])
+   [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.transit :as t]
+   [clojure.core.protocols :as cp]
+   [clojure.datafy :refer [datafy]]
+   [clojure.pprint :as pp]))
+
+;; TokensStatus datatype contains the activation status of the themes and sets
+;; in a tokens library.
+
+(defprotocol ITokensStatus
+  (get-active-theme-ids [_] "Return a clojure set of active theme ids")
+  (get-active-set-ids [_] "Return a clojure set of active set ids")
+  (theme-active? [_ theme-id] "Check if a theme is active")
+  (set-active? [_ set-id] "Check if a set is active")
+  (set-tokens-status [_ theme-ids set-ids] "Set the activation status of the themes and sets"))
+
+(deftype TokensStatus [active-theme-ids active-set-ids]
+  cp/Datafiable
+  (datafy [_]
+    {:active-theme-ids active-theme-ids
+     :active-set-ids active-set-ids})
+
+  #?@(:clj
+      [c.json/JSONWriter
+       (-write [this writter options]
+               (c.json/-write (datafy this) writter options))])
+
+  ITokensStatus
+  (get-active-theme-ids [_]
+    active-theme-ids)
+
+  (get-active-set-ids [_]
+    active-set-ids)
+
+  (theme-active? [_ theme-id]
+    (assert (uuid? theme-id))
+    (contains? active-theme-ids theme-id))
+
+  (set-active? [_ set-id]
+    (assert (uuid? set-id))
+    (contains? active-set-ids set-id))
+
+  (set-tokens-status [_ theme-ids set-ids]
+    (assert (set? theme-ids))
+    (assert (set? set-ids))
+    (TokensStatus. theme-ids set-ids)))
+
+;; === Helper & Predicate ===
+
+(defn map->TokensStatus
+  [{:keys [active-theme-ids active-set-ids]}]
+  (TokensStatus. active-theme-ids active-set-ids))
+
+(defn tokens-status?
+  [o]
+  (instance? TokensStatus o))
+
+;; === Schemas, Check functions & Constructor ===
+
+(declare make-tokens-status)
+
+(def schema:tokens-status-attrs
+  [:map {:title "TokensStatus"}
+   [:active-theme-ids {:optional true} [:set {:gen/max 5} ::sm/uuid]]
+   [:active-set-ids {:optional true} [:set {:gen/max 5} ::sm/uuid]]])
+
+(def schema:tokens-status
+  [:and {:gen/gen (->> (sg/generator schema:tokens-status-attrs)
+                       (sg/fmap #(make-tokens-status %)))}
+   [:fn tokens-status?]])
+
+(def ^:private check-tokens-status-attrs
+  (sm/check-fn schema:tokens-status-attrs
+               :hint "expected valid params for tokens-status"))
+
+(def check-tokens-status
+  (sm/check-fn schema:tokens-status
+               :hint "expected valid tokens-status"))
+
+(defn make-tokens-status
+  [& {:as attrs}]
+  (-> attrs
+      (update :active-theme-ids #(or % #{}))
+      (update :active-set-ids #(or % #{}))
+      (check-tokens-status-attrs)
+      (map->TokensStatus)))
+
+;; === Pretty-print for debugging ===
+
+(defmethod pp/simple-dispatch TokensStatus [^TokensStatus obj]
+  (.write *out* "#penpot/tokens-status ")
+  (pp/pprint-newline :miser)
+  (pp/pprint (datafy obj)))
+
+#?(:clj
+   (do
+     (defmethod print-method TokensStatus
+       [^TokensStatus this ^java.io.Writer w]
+       (.write w "#penpot/tokens-status ")
+       (print-method (datafy this) w))
+
+     (defmethod print-dup TokensStatus
+       [^TokensStatus this ^java.io.Writer w]
+       (print-method this w)))
+
+   :cljs
+   (extend-type TokensStatus
+     cljs.core/IPrintWithWriter
+     (-pr-writer [this writer opts]
+       (-write writer "#penpot/tokens-status ")
+       (-pr-writer (datafy this) writer opts))
+
+     cljs.core/IEncodeJS
+     (-clj->js [this]
+       (clj->js (datafy this)))))
+
+;; === Transit serialization ===
+
+(t/add-handlers!
+ {:id "penpot/tokens-status"
+  :class TokensStatus
+  :wfn datafy
+  :rfn #(make-tokens-status %)})
+
+;; === Fressian serialization ===
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/tokens-status/v1"
+     :class TokensStatus
+     :wfn (fn [n w o]
+            (fres/write-tag! w n 1)
+            (fres/write-object! w (datafy o)))
+     :rfn (fn [r]
+            (let [obj (fres/read-object! r)]
+              (make-tokens-status obj)))}))
--- a/common/test/common_tests/runner.cljc
+++ b/common/test/common_tests/runner.cljc
@ -86,6 +86,7 @@
   [common-tests.types.shape-layout-test]
   [common-tests.types.token-test]
   [common-tests.types.tokens-lib-test]
+   [common-tests.types.tokens-status-test]
   [common-tests.undo-stack-test]
   [common-tests.uuid-test]))

@ -164,6 +165,7 @@
   'common-tests.types.shape-layout-test
   'common-tests.types.token-test
   'common-tests.types.tokens-lib-test
+   'common-tests.types.tokens-status-test
   'common-tests.undo-stack-test
   'common-tests.uuid-test])

--- a/common/test/common_tests/types/tokens_status_test.cljc
+++ b/common/test/common_tests/types/tokens_status_test.cljc
@ -0,0 +1,101 @@
+;; 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 common-tests.types.tokens-status-test
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as json])
+   [app.common.transit :as tr]
+   [app.common.types.tokens-status :as ctos]
+   [app.common.uuid :as uuid]
+   [clojure.datafy :refer [datafy]]
+   [clojure.test :as t]))
+
+(t/deftest make-tokens-status
+  (let [theme-id (uuid/next)
+        set-id   (uuid/next)
+        status   (ctos/make-tokens-status :active-theme-ids #{theme-id}
+                                          :active-set-ids #{set-id})]
+    (t/is (ctos/tokens-status? status))
+    (t/is (ctos/check-tokens-status status))
+    (t/is (= 1 (count (ctos/get-active-theme-ids status))))
+    (t/is (ctos/theme-active? status theme-id))
+    (t/is (= 1 (count (ctos/get-active-set-ids status))))
+    (t/is (ctos/set-active? status set-id))))
+
+(t/deftest make-tokens-status-defaults
+  (let [status (ctos/make-tokens-status)]
+    (t/is (ctos/tokens-status? status))
+    (t/is (ctos/check-tokens-status status))
+    (t/is (= 0 (count (ctos/get-active-theme-ids status))))
+    (t/is (= 0 (count (ctos/get-active-set-ids status))))))
+
+(t/deftest make-invalid-tokens-status
+  (t/testing "non-set for active-themes"
+    (t/is (thrown-with-msg? #?(:cljs js/Error :clj Exception)
+                            #"expected valid params for tokens-status"
+                            (ctos/make-tokens-status :active-theme-ids []))))
+  (t/testing "non-uuid in active-sets"
+    (t/is (thrown-with-msg? #?(:cljs js/Error :clj Exception)
+                            #"expected valid params for tokens-status"
+                            (ctos/make-tokens-status :active-set-ids #{"not-a-uuid"})))))
+
+(t/deftest set-tokens-status
+  (let [theme1-id (uuid/next)
+        theme2-id (uuid/next)
+        theme3-id (uuid/next)
+        set1-id (uuid/next)
+        set2-id (uuid/next)
+        set3-id (uuid/next)
+        status (-> (ctos/make-tokens-status {:active-theme-ids #{theme3-id}
+                                             :active-set-ids #{set3-id}})
+                   (ctos/set-tokens-status #{theme1-id theme2-id} #{set1-id set2-id}))]
+    (t/is (= #{theme1-id theme2-id} (ctos/get-active-theme-ids status)))
+    (t/is (= #{set1-id set2-id} (ctos/get-active-set-ids status)))))
+
+(t/deftest datafy-tokens-status
+  (let [theme-id (uuid/next)
+        set-id   (uuid/next)
+        status   (ctos/make-tokens-status :active-theme-ids #{theme-id}
+                                          :active-set-ids #{set-id})
+        result   (datafy status)]
+    (t/is (map? result))
+    (t/is (not (ctos/tokens-status? result)))
+    (t/is (= (:active-theme-ids result) #{theme-id}))
+    (t/is (= (:active-set-ids result) #{set-id}))))
+
+(t/deftest transit-serialization
+  (let [theme-id (uuid/next)
+        set-id   (uuid/next)
+        status   (ctos/make-tokens-status :active-theme-ids #{theme-id}
+                                          :active-set-ids #{set-id})
+        encoded  (tr/encode-str status)
+        status'  (tr/decode-str encoded)]
+    (t/is (ctos/tokens-status? status'))
+    (t/is (= (datafy status') (datafy status)))))
+
+#?(:clj
+   (t/deftest fressian-serialization
+     (let [theme-id  (uuid/next)
+           set-id    (uuid/next)
+           status    (ctos/make-tokens-status :active-theme-ids #{theme-id}
+                                              :active-set-ids #{set-id})
+           encoded   (fres/encode status)
+           status'   (fres/decode encoded)]
+       (t/is (ctos/tokens-status? status'))
+       (t/is (= (datafy status') (datafy status))))))
+
+#?(:clj
+   (t/deftest json-serialization
+     (let [theme-id (uuid/next)
+           set-id   (uuid/next)
+           status   (ctos/make-tokens-status :active-theme-ids #{theme-id}
+                                             :active-set-ids #{set-id})
+           json-str (json/write-str status)
+           parsed   (json/read-str json-str :key-fn keyword)]
+       (t/is (map? parsed))
+       (t/is (= [(str theme-id)] (:active-theme-ids parsed)))
+       (t/is (= [(str set-id)] (:active-set-ids parsed))))))