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

backend/src/app/features/components_v2.clj

@@ -431,9 +431,11 @@
         fix-empty-components
         (fn [file-data]
           (letfn [(fix-component [components id component]
-                    (if (empty? (:objects component))
+                    (let [root-shape (ctst/get-shape component (:id component))]
-                      (dissoc components id)
+                      (if (or (empty? (:objects component))
-                      components))]
+                              (nil? root-shape))
+                        (dissoc components id)
+                        components)))]
 
             (-> file-data
                 (d/update-when :components #(reduce-kv fix-component % %)))))

backend/src/app/http/debug.clj

@@ -413,13 +413,8 @@
                 :code :invalid-version
                 :hint "provided invalid version"))
 
-    (binding [srepl/*system* cfg]
+    (db/tx-run! cfg srepl/process-file! file-id #(update % :data assoc :version version))
-      (srepl/process-file! :id file-id
+
-                           :update-fn (fn [file]
-                                        (update file :data assoc :version version))
-                           :migrate? false
-                           :inc-revn? false
-                           :save? true))
     {::rres/status  200
      ::rres/headers {"content-type" "text/plain"}
      ::rres/body    "OK"}))

backend/src/app/rpc.clj

@@ -149,9 +149,11 @@
         (let [params (decode params)]
           (if (validate params)
             (f cfg params)
-            (ex/raise :type :validation
+
-                      :code :params-validation
+            (let [params (d/without-qualified params)]
-                      ::sm/explain (explain params))))))
+              (ex/raise :type :validation
+                        :code :params-validation
+                        ::sm/explain (explain params)))))))
     f))
 
 (defn- wrap-output-validation

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

@@ -147,8 +147,9 @@
                       (restore-file-snapshot! cfg params)))))
 
 (defn take-file-snapshot!
-  [{:keys [::db/conn]} {:keys [file-id label]}]
+  [cfg {:keys [file-id label]}]
-  (let [file  (db/get conn :file {:id file-id})
+  (let [conn  (db/get-connection cfg)
+        file  (db/get conn :file {:id file-id})
         id    (uuid/next)]
 
     (l/debug :hint "creating file snapshot"

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

@@ -42,30 +42,28 @@
 
 (def ^:private
   schema:update-file
-  (sm/define
+  [:map {:title "update-file"}
-    [:map {:title "update-file"}
+   [:id ::sm/uuid]
-     [:id ::sm/uuid]
+   [:session-id ::sm/uuid]
-     [:session-id ::sm/uuid]
+   [:revn {:min 0} :int]
-     [:revn {:min 0} :int]
+   [:features {:optional true} ::cfeat/features]
-     [:features {:optional true} ::cfeat/features]
+   [:changes {:optional true} [:vector ::cpc/change]]
-     [:changes {:optional true} [:vector ::cpc/change]]
+   [:changes-with-metadata {:optional true}
-     [:changes-with-metadata {:optional true}
+    [:vector [:map
-      [:vector [:map
+              [:changes [:vector ::cpc/change]]
-                [:changes [:vector ::cpc/change]]
+              [:hint-origin {:optional true} :keyword]
-                [:hint-origin {:optional true} :keyword]
+              [:hint-events {:optional true} [:vector :string]]]]]
-                [:hint-events {:optional true} [:vector :string]]]]]
+   [:skip-validate {:optional true} :boolean]])
-     [:skip-validate {:optional true} :boolean]]))
 
 (def ^:private
   schema:update-file-result
-  (sm/define
+  [:vector {:title "update-file-result"}
-    [:vector {:title "update-file-result"}
+   [:map
-     [:map
+    [:changes [:vector ::cpc/change]]
-      [:changes [:vector ::cpc/change]]
+    [:file-id ::sm/uuid]
-      [:file-id ::sm/uuid]
+    [:id ::sm/uuid]
-      [:id ::sm/uuid]
+    [:revn {:min 0} :int]
-      [:revn {:min 0} :int]
+    [:session-id ::sm/uuid]]])
-      [:session-id ::sm/uuid]]]))
 
 ;; --- HELPERS
 
@@ -73,14 +71,26 @@
 ;; to all clients using it.
 
 (def ^:private library-change-types
-  #{:add-color :mod-color :del-color
+  #{:add-color
-    :add-media :mod-media :del-media
+    :mod-color
-    :add-component :mod-component :del-component :restore-component
+    :del-color
-    :add-typography :mod-typography :del-typography})
+    :add-media
+    :mod-media
+    :del-media
+    :add-component
+    :mod-component
+    :del-component
+    :restore-component
+    :add-typography
+    :mod-typography
+    :del-typography})
 
 (def ^:private file-change-types
-  #{:add-obj :mod-obj :del-obj
+  #{:add-obj
-    :reg-objects :mov-objects})
+    :mod-obj
+    :del-obj
+    :reg-objects
+    :mov-objects})
 
 (defn- library-change?
   [{:keys [type] :as change}]

backend/src/app/srepl/fixes.clj

@@ -0,0 +1,94 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.srepl.fixes
+  "A misc of fix functions"
+  (:refer-clojure :exclude [parse-uuid])
+  (:require
+   [app.binfile.common :as bfc]
+   [app.common.data :as d]
+   [app.common.files.changes :as cpc]
+   [app.common.files.repair :as cfr]
+   [app.common.files.validate :as cfv]
+   [app.common.logging :as l]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.srepl.helpers :as h]))
+
+(defn repair-file-media
+  "A helper intended to be used with `srepl.main/process-files!` that
+  fixes all not propertly referenced file-media-object for a file"
+  [{:keys [id data] :as file} & _]
+  (let [conn  (db/get-connection h/*system*)
+        used  (bfc/collect-used-media data)
+        ids   (db/create-array conn "uuid" used)
+        sql   (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
+        rows  (db/exec! conn [sql ids])
+        index (reduce (fn [index media]
+                        (if (not= (:file-id media) id)
+                          (let [media-id (uuid/next)]
+                            (l/wrn :hint "found not referenced media"
+                                   :file-id (str id)
+                                   :media-id (str (:id media)))
+
+                            (db/insert! conn :file-media-object
+                                        (-> media
+                                            (assoc :file-id id)
+                                            (assoc :id media-id)))
+                            (assoc index (:id media) media-id))
+                          index))
+                      {}
+                      rows)]
+
+    (when (seq index)
+      (binding [bfc/*state* (atom {:index index})]
+        (update file :data (fn [fdata]
+                             (-> fdata
+                                 (update :pages-index #'bfc/relink-shapes)
+                                 (update :components #'bfc/relink-shapes)
+                                 (update :media #'bfc/relink-media)
+                                 (d/without-nils))))))))
+
+
+(defn repair-file
+  "Internal helper for validate and repair the file. The operation is
+  applied multiple times untile file is fixed or max iteration counter
+  is reached (default 10)"
+  [file libs & {:keys [max-iterations] :or {max-iterations 10}}]
+
+  (let [validate-and-repair
+        (fn [file libs iteration]
+          (when-let [errors (not-empty (cfv/validate-file file libs))]
+            (l/trc :hint "repairing file"
+                   :file-id (str (:id file))
+                   :iteration iteration
+                   :errors (count errors))
+            (let [changes (cfr/repair-file file libs errors)]
+              (-> file
+                  (update :revn inc)
+                  (update :data cpc/process-changes changes)))))
+
+        process-file
+        (fn [file libs]
+          (loop [file      file
+                 iteration 0]
+            (if (< iteration max-iterations)
+              (if-let [file (validate-and-repair file libs iteration)]
+                (recur file (inc iteration))
+                file)
+              (do
+                (l/wrn :hint "max retry num reached on repairing file"
+                       :file-id (str (:id file))
+                       :iteration iteration)
+                file))))
+
+        file'
+        (process-file file libs)]
+
+    (when (not= (:revn file) (:revn file'))
+      (l/trc :hint "file repaired" :file-id (str (:id file))))
+
+    file'))

backend/src/app/srepl/helpers.clj

@@ -7,39 +7,18 @@
 (ns app.srepl.helpers
   "A  main namespace for server repl."
   (:refer-clojure :exclude [parse-uuid])
-  #_:clj-kondo/ignore
   (:require
-   [app.binfile.common :as bfc]
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.features :as cfeat]
-   [app.common.files.changes :as cpc]
    [app.common.files.migrations :as fmg]
    [app.common.files.validate :as cfv]
-   [app.common.logging :as l]
-   [app.common.pprint :refer [pprint]]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config :as cfg]
    [app.db :as db]
-   [app.db.sql :as sql]
+   [app.features.components-v2 :as feat.comp-v2]
    [app.features.fdata :as feat.fdata]
    [app.main :as main]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.files-update :as files-update]
+   [app.rpc.commands.files-snapshot :as fsnap]
    [app.util.blob :as blob]
-   [app.util.objects-map :as omap]
+   [app.util.pointer-map :as pmap]))
-   [app.util.pointer-map :as pmap]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
-   [clojure.stacktrace :as strace]
-   [clojure.walk :as walk]
-   [cuerdas.core :as str]
-   [expound.alpha :as expound]
-   [promesa.core :as p]
-   [promesa.exec :as px]
-   [promesa.exec.semaphore :as ps]
-   [promesa.util :as pu]))
 
 (def ^:dynamic *system* nil)
 
@@ -54,25 +33,6 @@
     (d/parse-uuid v)
     v))
 
-;; (def ^:private sql:get-and-lock-team-files
-;;   "SELECT f.id
-;;      FROM file AS f
-;;      JOIN project AS p ON (p.id = f.project_id)
-;;     WHERE p.team_id = ?
-;;       FOR UPDATE")
-
-;; (defn get-and-lock-team-files
-;;   [conn team-id]
-;;   (->> (db/exec! conn [sql:get-and-lock-team-files team-id])
-;;        (into #{} (map :id))))
-
-;; (defn get-team
-;;   [system team-id]
-;;   (-> (db/get system :team {:id team-id}
-;;               {::db/remove-deleted false
-;;                ::db/check-deleted false})
-;;       (update :features db/decode-pgarray #{})))
-
 (defn get-file
   "Get the migrated data of one file."
   ([id] (get-file (or *system* main/system) id))
@@ -107,8 +67,10 @@
                 {:revn (:revn file)
                  :data (:data file)
                  :features (:features file)
+                 :deleted-at (:deleted-at file)
+                 :created-at (:created-at file)
+                 :modified-at (:modified-at file)
                  :data-backend nil
-                 :modified-at (dt/now)
                  :has-media-trimmed false}
                 {:id (:id file)})))
 
@@ -125,213 +87,90 @@
 
 (defn reset-file-data!
   "Hardcode replace of the data of one file."
-  [id data]
+  [system id data]
-  (db/tx-run! main/system
+  (db/tx-run! system
               (fn [system]
                 (db/update! system :file
                             {:data data}
                             {:id id}))))
 
-(defn process-file*
-  [system file-id update-fn]
-  (let [file (get-file system file-id)
-        file (-> (update-fn file)
-                 (update :revn inc))]
 
-    (cfv/validate-file-schema! file)
+(def ^:private sql:snapshots-with-file
-    (update-file! system file)
+  "WITH files AS (
-    (dissoc file :data)))
+     SELECT f.id AS file_id,
+            (SELECT fc.id
+               FROM file_change AS fc
+              WHERE fc.label = ?
+                AND fc.file_id = f.id
+              ORDER BY fc.created_at DESC
+              LIMIT 1) AS id
+       FROM file AS f
+   ) SELECT * FROM files
+      WHERE file_id = ANY(?)
+        AND id IS NOT NULL")
+
+(defn get-file-snapshots
+  "Get a seq parirs of file-id and snapshot-id for a set of files
+   and specified label"
+  [conn label ids]
+  (db/exec! conn [sql:snapshots-with-file label
+                  (db/create-array conn "uuid" ids)]))
+
+(defn take-team-snapshot!
+  [system team-id label]
+  (let [conn (db/get-connection system)]
+    (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+         (map (fn [file-id]
+                {:file-id file-id
+                 :label label}))
+         (reduce (fn [result params]
+                   (fsnap/take-file-snapshot! conn params)
+                   (inc result))
+                 0))))
+
+(defn restore-team-snapshot!
+  [system team-id label]
+  (let [conn (db/get-connection system)
+        ids  (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+                  (into #{}))
+
+        snap (get-file-snapshots conn label ids)
+
+        ids' (into #{} (map :file-id) snap)
+        team (-> (feat.comp-v2/get-team conn team-id)
+                 (update :features disj "components/v2"))]
+
+    (when (not= ids ids')
+      (throw (RuntimeException. "no uniform snapshot available")))
+
+    (feat.comp-v2/update-team! conn team)
+    (reduce (fn [result params]
+              (fsnap/restore-file-snapshot! conn params)
+              (inc result))
+            0
+            snap)))
 
 (defn process-file!
-  "Apply a function to the data of one file. Optionally save the changes or not.
+  [system file-id update-fn & {:keys [label validate? with-libraries?] :or {validate? true} :as opts}]
-  The function receives the decoded and migrated file data."
-  [& {:keys [update-fn id rollback?]
-      :or {rollback? true}}]
 
-  (let [system (or *system* (assoc main/system ::db/rollback rollback?))]
+  (when (string? label)
-    (db/tx-run! system
+    (fsnap/take-file-snapshot! system {:file-id file-id :label label}))
-                (fn [system]
-                  (binding [*system* system]
-                    (process-file* system id update-fn))))))
 
+  (let [conn  (db/get-connection system)
+        file  (get-file system file-id)
+        libs  (when with-libraries?
+                (->> (files/get-file-libraries conn file-id)
+                     (into [file] (map (fn [{:keys [id]}]
+                                         (get-file system id))))
+                     (d/index-by :id)))
 
-(def ^:private sql:get-file-ids
+        file' (if with-libraries?
-  "SELECT id FROM file
+                (update-fn file libs opts)
-    WHERE created_at < ? AND deleted_at is NULL
+                (update-fn file opts))]
-    ORDER BY created_at DESC")
 
-(defn analyze-files
+    (when (and (some? file)
-  "Apply a function to all files in the database, reading them in
+               (not (identical? file file')))
-  batches. Do not change data.
+      (when validate? (cfv/validate-file-schema! file'))
-
+      (let [file' (update file' :revn inc)]
-  The `on-file` parameter should be a function that receives the file
+        (update-file! system file')
-  and the previous state and returns the new state.
+        true))))
-
-  Emits rollback at the end of operation."
-  [& {:keys [max-items start-at on-file on-error on-end on-init with-libraries?]}]
-  (letfn [(get-candidates [conn]
-            (cond->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
-              (some? max-items)
-              (take max-items)))
-
-          (on-error* [cause file]
-            (println "unexpected exception happened on processing file: " (:id file))
-            (strace/print-stack-trace cause))
-
-          (process-file [{:keys [::db/conn] :as system} file-id]
-            (let [file (get-file system file-id)
-                  libs (when with-libraries?
-                         (->> (files/get-file-libraries conn file-id)
-                              (into [file] (map (fn [{:keys [id]}]
-                                                  (get-file system id))))
-                              (d/index-by :id)))]
-              (try
-                (if with-libraries?
-                  (on-file file libs)
-                  (on-file file))
-                (catch Throwable cause
-                  ((or on-error on-error*) cause file)))))]
-
-    (db/tx-run! (assoc main/system ::db/rollback true)
-                (fn [{:keys [::db/conn] :as system}]
-                  (try
-                    (binding [*system* system]
-                      (when (fn? on-init) (on-init))
-                      (run! (partial process-file system)
-                            (get-candidates conn)))
-                    (finally
-                      (when (fn? on-end)
-                        (ex/ignoring (on-end)))))))))
-
-(defn process-files!
-  "Apply a function to all files in the database"
-  [& {:keys [max-items
-             max-jobs
-             start-at
-             on-file
-             validate?
-             rollback?]
-      :or {max-jobs 1
-           max-items Long/MAX_VALUE
-           validate? true
-           rollback? true}}]
-
-  (l/dbg :hint "process:start"
-         :rollback rollback?
-         :max-jobs max-jobs
-         :max-items max-items)
-
-  (let [tpoint    (dt/tpoint)
-        factory   (px/thread-factory :virtual false :prefix "penpot/file-process/")
-        executor  (px/cached-executor :factory factory)
-        sjobs     (ps/create :permits max-jobs)
-
-        process-file
-        (fn [file-id idx tpoint]
-          (try
-            (l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
-            (db/tx-run! (assoc main/system ::db/rollback rollback?)
-                        (fn [{:keys [::db/conn] :as system}]
-                          (let [file' (get-file system file-id)
-                                file  (binding [*system* system]
-                                        (on-file file'))]
-
-                            (when (and (some? file) (not (identical? file file')))
-
-                              (when validate?
-                                (cfv/validate-file-schema! file))
-
-                              (let [file (if (contains? (:features file) "fdata/objects-map")
-                                           (feat.fdata/enable-objects-map file)
-                                           file)
-
-                                    file (if (contains? (:features file) "fdata/pointer-map")
-                                           (binding [pmap/*tracked* (pmap/create-tracked)]
-                                             (let [file (feat.fdata/enable-pointer-map file)]
-                                               (feat.fdata/persist-pointers! system file-id)
-                                               file))
-                                           file)]
-
-                                (db/update! conn :file
-                                            {:data (blob/encode (:data file))
-                                             :deleted-at (:deleted-at file)
-                                             :created-at (:created-at file)
-                                             :modified-at (:modified-at file)
-                                             :features (db/create-array conn "text" (:features file))
-                                             :revn (:revn file)}
-                                            {:id file-id}))))))
-            (catch Throwable cause
-              (l/wrn :hint "unexpected error on processing file (skiping)"
-                     :file-id (str file-id)
-                     :index idx
-                     :cause cause))
-            (finally
-              (ps/release! sjobs)
-              (let [elapsed (dt/format-duration (tpoint))]
-                (l/trc :hint "process:file:end"
-                       :file-id (str file-id)
-                       :index idx
-                       :elapsed elapsed)))))]
-
-    (try
-      (db/tx-run! main/system
-                  (fn [{:keys [::db/conn] :as system}]
-                    (db/exec! conn ["SET statement_timeout = 0"])
-                    (db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])
-
-                    (try
-                      (reduce (fn [idx file-id]
-                                (ps/acquire! sjobs)
-                                (px/run! executor (partial process-file file-id idx (dt/tpoint)))
-                                (inc idx))
-                              0
-                              (->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
-                                   (take max-items)
-                                   (map :id)))
-                      (finally
-                        ;; Close and await tasks
-                        (pu/close! executor)))))
-
-      (catch Throwable cause
-        (l/dbg :hint "process:error" :cause cause))
-
-      (finally
-        (let [elapsed (dt/format-duration (tpoint))]
-          (l/dbg :hint "process:end"
-                 :rollback rollback?
-                 :elapsed elapsed))))))
-
-
-(defn repair-file-media
-  "A helper intended to be used with `process-files!` that fixes all
-  not propertly referenced file-media-object for a file"
-  [{:keys [id data] :as file}]
-  (let [conn  (db/get-connection *system*)
-        used  (bfc/collect-used-media data)
-        ids   (db/create-array conn "uuid" used)
-        sql   (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
-        rows  (db/exec! conn [sql ids])
-        index (reduce (fn [index media]
-                        (if (not= (:file-id media) id)
-                          (let [media-id (uuid/next)]
-                            (l/wrn :hint "found not referenced media"
-                                   :file-id (str id)
-                                   :media-id (str (:id media)))
-
-                            (db/insert! *system* :file-media-object
-                                        (-> media
-                                            (assoc :file-id id)
-                                            (assoc :id media-id)))
-                            (assoc index (:id media) media-id))
-                          index))
-                      {}
-                      rows)]
-
-    (when (seq index)
-      (binding [bfc/*state* (atom {:index index})]
-        (update file :data (fn [fdata]
-                             (-> fdata
-                                 (update :pages-index #'bfc/relink-shapes)
-                                 (update :components #'bfc/relink-shapes)
-                                 (update :media #'bfc/relink-media)
-                                 (d/without-nils))))))))

backend/src/app/srepl/main.clj

@@ -12,9 +12,8 @@
    [app.binfile.common :as bfc]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
-   [app.common.files.changes :as cpc]
-   [app.common.files.repair :as cfr]
    [app.common.files.validate :as cfv]
    [app.common.logging :as l]
    [app.common.pprint :as p]
@@ -31,17 +30,19 @@
    [app.rpc.commands.files-snapshot :as fsnap]
    [app.rpc.commands.management :as mgmt]
    [app.rpc.commands.profile :as profile]
-   [app.srepl.cli :as cli]
+   [app.srepl.fixes :as fixes]
    [app.srepl.helpers :as h]
-   [app.storage :as sto]
    [app.util.blob :as blob]
-   [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.pprint :refer [pprint print-table]]
+   [clojure.pprint :refer [print-table]]
+   [clojure.stacktrace :as strace]
    [clojure.tools.namespace.repl :as repl]
-   [cuerdas.core :as str]))
+   [cuerdas.core :as str]
+   [promesa.exec :as px]
+   [promesa.exec.semaphore :as ps]
+   [promesa.util :as pu]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; TASKS
@@ -138,24 +139,20 @@
 ;; FEATURES
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(declare process-file!)
+
 (defn enable-objects-map-feature-on-file!
-  [& {:keys [save? id]}]
+  [file-id & {:as opts}]
-  (h/process-file! main/system
+  (process-file! file-id feat.fdata/enable-objects-map opts))
-                   :id id
-                   :update-fn feat.fdata/enable-objects-map
-                   :save? save?))
 
 (defn enable-pointer-map-feature-on-file!
-  [& {:keys [save? id]}]
+  [file-id & {:as opts}]
-  (h/process-file! main/system
+  (process-file! file-id feat.fdata/enable-pointer-map opts))
-                   :id id
-                   :update-fn feat.fdata/enable-pointer-map
-                   :save? save?))
 
 (defn enable-storage-features-on-file!
-  [& {:as params}]
+  [file-id & {:as opts}]
-  (enable-objects-map-feature-on-file! main/system params)
+  (enable-objects-map-feature-on-file! file-id opts)
-  (enable-pointer-map-feature-on-file! main/system params))
+  (enable-pointer-map-feature-on-file! file-id opts))
 
 (defn enable-team-feature!
   [team-id feature]
@@ -308,84 +305,40 @@
     (db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
 
 (defn restore-file-snapshot!
-  [& {:keys [file-id id]}]
+  [file-id label]
-  (db/tx-run! main/system
+  (let [file-id (h/parse-uuid file-id)]
-              (fn [cfg]
+    (db/tx-run! main/system
-                (let [file-id (h/parse-uuid file-id)
+                (fn [{:keys [::db/conn] :as system}]
-                      id      (h/parse-uuid id)]
+                  (when-let [snapshot (->> (h/get-file-snapshots conn label #{file-id})
-                  (if (and (uuid? id) (uuid? file-id))
+                                           (map :id)
-                    (fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
+                                           (first))]
-                    (println "=> invalid parameters"))))))
+                    (fsnap/restore-file-snapshot! system
-
+                                                  {:id (:id snapshot)
+                                                   :file-id file-id}))))))
 
 (defn list-file-snapshots!
-  [& {:keys [file-id limit]}]
+  [file-id & {:keys [limit]}]
-  (db/tx-run! main/system
+  (let [file-id (h/parse-uuid file-id)]
-              (fn [system]
+    (db/tx-run! main/system
-                (let [params {:file-id (h/parse-uuid file-id)
+                (fn [system]
-                              :limit limit}]
+                  (let [params {:file-id file-id :limit limit}]
-                  (->> (fsnap/get-file-snapshots system (d/without-nils params))
+                    (->> (fsnap/get-file-snapshots system (d/without-nils params))
-                       (print-table [:id :revn :created-at :label]))))))
+                         (print-table [:label :id :revn :created-at])))))))
 
 (defn take-team-snapshot!
-  [& {:keys [team-id label rollback?]
+  [team-id & {:keys [label rollback?] :or {rollback? true}}]
-      :or {rollback? true}}]
   (let [team-id (h/parse-uuid team-id)
-        label   (or label (fsnap/generate-snapshot-label))
+        label   (or label (fsnap/generate-snapshot-label))]
-
-        take-snapshot
-        (fn [{:keys [::db/conn] :as system}]
-          (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
-               (map (fn [file-id]
-                      {:file-id file-id
-                       :label label}))
-               (run! (partial fsnap/take-file-snapshot! system))))]
-
     (-> (assoc main/system ::db/rollback rollback?)
-        (db/tx-run! take-snapshot))))
+        (db/tx-run! h/take-team-snapshot! team-id label))))
-
-(def ^:private sql:snapshots-with-file
-  "WITH files AS (
-     SELECT f.id AS file_id,
-            (SELECT fc.id
-               FROM file_change AS fc
-              WHERE fc.label = ?
-                AND fc.file_id = f.id
-              ORDER BY fc.created_at DESC
-              LIMIT 1) AS id
-       FROM file AS f
-   ) SELECT * FROM files
-      WHERE file_id = ANY(?)
-        AND id IS NOT NULL")
 
 (defn restore-team-snapshot!
   "Restore a snapshot on all files of the team. The snapshot should
   exists for all files; if is not the case, an exception is raised."
-  [& {:keys [team-id label rollback?] :or {rollback? true}}]
+  [team-id label & {:keys [rollback?] :or {rollback? true}}]
-  (let [team-id (h/parse-uuid team-id)
+  (let [team-id (h/parse-uuid team-id)]
-
-        get-file-snapshots
-        (fn [conn ids]
-          (db/exec! conn [sql:snapshots-with-file label
-                          (db/create-array conn "uuid" ids)]))
-
-        restore-snapshot
-        (fn [{:keys [::db/conn] :as system}]
-          (let [ids  (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
-                          (into #{}))
-                snap (get-file-snapshots conn ids)
-                ids' (into #{} (map :file-id) snap)
-                team (-> (feat.comp-v2/get-team conn team-id)
-                         (update :features disj "components/v2"))]
-
-            (when (not= ids ids')
-              (throw (RuntimeException. "no uniform snapshot available")))
-
-            (feat.comp-v2/update-team! conn team)
-            (run! (partial fsnap/restore-file-snapshot! system) snap)))]
-
     (-> (assoc main/system ::db/rollback rollback?)
-        (db/tx-run! restore-snapshot))))
+        (db/tx-run! h/restore-team-snapshot! team-id label))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; FILE VALIDATION & REPAIR
@@ -394,68 +347,163 @@
 (defn validate-file
   "Validate structure, referencial integrity and semantic coherence of
   all contents of a file. Returns a list of errors."
-  [id]
+  [file-id]
-  (db/tx-run! main/system
+  (let [file-id (h/parse-uuid file-id)]
-              (fn [{:keys [::db/conn] :as system}]
+    (db/tx-run! (assoc main/system ::db/rollback true)
-                (let [id   (if (string? id) (parse-uuid id) id)
-                      file (h/get-file system id)
-                      libs (->> (files/get-file-libraries conn id)
-                                (into [file] (map (fn [{:keys [id]}]
-                                                    (h/get-file system id))))
-                                (d/index-by :id))]
-                  (cfv/validate-file file libs)))))
-
-(defn- repair-file*
-  "Internal helper for validate and repair the file. The operation is
-  applied multiple times untile file is fixed or max iteration counter
-  is reached (default 10)"
-  [system id & {:keys [max-iterations label] :or {max-iterations 10}}]
-  (let [id (parse-uuid id)
-
-        validate-and-repair
-        (fn [file libs iteration]
-          (when-let [errors (not-empty (cfv/validate-file file libs))]
-            (l/trc :hint "repairing file"
-                   :file-id (str id)
-                   :iteration iteration
-                   :errors (count errors))
-            (let [changes (cfr/repair-file file libs errors)]
-              (-> file
-                  (update :revn inc)
-                  (update :data cpc/process-changes changes)))))
-
-        process-file
-        (fn [file libs]
-          (loop [file      file
-                 iteration 0]
-            (if (< iteration max-iterations)
-              (if-let [file (validate-and-repair file libs iteration)]
-                (recur file (inc iteration))
-                file)
-              (do
-                (l/wrn :hint "max retry num reached on repairing file"
-                       :file-id (str id)
-                       :iteration iteration)
-                file))))]
-
-    (db/tx-run! system
                 (fn [{:keys [::db/conn] :as system}]
-                  (when (string? label)
+                  (let [file (h/get-file system file-id)
-                    (fsnap/take-file-snapshot! system {:file-id id :label label}))
+                        libs (->> (files/get-file-libraries conn file-id)
-
-                  (let [file (h/get-file system id)
-                        libs (->> (files/get-file-libraries conn id)
                                   (into [file] (map (fn [{:keys [id]}]
                                                       (h/get-file system id))))
-                                  (d/index-by :id))
+                                  (d/index-by :id))]
-                        file (process-file file libs)]
+                    (cfv/validate-file file libs))))))
-                    (h/update-file! system file))))))
 
 (defn repair-file!
   "Repair the list of errors detected by validation."
   [file-id & {:keys [rollback?] :or {rollback? true} :as opts}]
-  (let [system (assoc main/system ::db/rollback rollback?)]
+  (let [system  (assoc main/system ::db/rollback rollback?)
-    (repair-file* system file-id (dissoc opts :rollback?))))
+        file-id (h/parse-uuid file-id)
+        opts    (assoc opts :with-libraries? true)]
+    (db/tx-run! system h/process-file! file-id fixes/repair-file opts)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PROCESSING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private
+  sql:get-file-ids
+  "SELECT id FROM file
+    WHERE created_at < ? AND deleted_at is NULL
+    ORDER BY created_at DESC")
+
+(defn analyze-files
+  "Apply a function to all files in the database, reading them in
+  batches. Do not change data.
+
+  The `on-file` parameter should be a function that receives the file
+  and the previous state and returns the new state.
+
+  Emits rollback at the end of operation."
+  [on-file & {:keys [max-items start-at with-libraries?]}]
+  (letfn [(get-candidates [conn]
+            (cond->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
+              (some? max-items)
+              (take max-items)))
+
+          (process-file [{:keys [::db/conn] :as system} file-id]
+            (let [file (h/get-file system file-id)
+                  libs (when with-libraries?
+                         (->> (files/get-file-libraries conn file-id)
+                              (into [file] (map (fn [{:keys [id]}]
+                                                  (h/get-file system id))))
+                              (d/index-by :id)))]
+              (if with-libraries?
+                (on-file file libs)
+                (on-file file))))]
+
+    (db/tx-run! (assoc main/system ::db/rollback true)
+                (fn [{:keys [::db/conn] :as system}]
+                  (binding [h/*system* system]
+                    (run! (partial process-file system)
+                          (get-candidates conn)))))))
+
+(defn process-file!
+  "Apply a function to the file. Optionally save the changes or not.
+  The function receives the decoded and migrated file data."
+  [file-id update-fn & {:keys [rollback?] :or {rollback? true}}]
+  (db/tx-run! (assoc main/system ::db/rollback rollback?)
+              (fn [system]
+                (binding [h/*system* system]
+                  (h/process-file! system file-id update-fn)))))
+
+(defn process-team-files!
+  "Apply a function to each file of the specified team."
+  [team-id update-fn & {:keys [rollback? label] :or {rollback? true} :as opts}]
+  (let [team-id (h/parse-uuid team-id)
+        opts    (dissoc opts :label)]
+    (db/tx-run! (assoc main/system ::db/rollback rollback?)
+                (fn [{:keys [::db/conn] :as system}]
+                  (when (string? label)
+                    (h/take-team-snapshot! system team-id label))
+
+                  (binding [h/*system* system]
+                    (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+                         (reduce (fn [result file-id]
+                                   (if (h/process-file! system file-id update-fn opts)
+                                     (inc result)
+                                     result))
+                                 0)))))))
+
+(defn process-files!
+  "Apply a function to all files in the database"
+  [update-fn & {:keys [max-items
+                       max-jobs
+                       start-at
+                       rollback?]
+                :or {max-jobs 1
+                     max-items Long/MAX_VALUE
+                     rollback? true}
+                :as opts}]
+
+  (l/dbg :hint "process:start"
+         :rollback rollback?
+         :max-jobs max-jobs
+         :max-items max-items)
+
+  (let [tpoint    (dt/tpoint)
+        factory   (px/thread-factory :virtual false :prefix "penpot/file-process/")
+        executor  (px/cached-executor :factory factory)
+        sjobs     (ps/create :permits max-jobs)
+
+        process-file
+        (fn [file-id idx tpoint]
+          (try
+            (l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
+            (let [system (assoc main/system ::db/rollback rollback?)]
+              (db/tx-run! system h/process-file! file-id update-fn opts))
+
+            (catch Throwable cause
+              (l/wrn :hint "unexpected error on processing file (skiping)"
+                     :file-id (str file-id)
+                     :index idx
+                     :cause cause))
+            (finally
+              (ps/release! sjobs)
+              (let [elapsed (dt/format-duration (tpoint))]
+                (l/trc :hint "process:file:end"
+                       :file-id (str file-id)
+                       :index idx
+                       :elapsed elapsed)))))
+
+        process-files
+        (fn [{:keys [::db/conn] :as system}]
+          (db/exec! conn ["SET statement_timeout = 0"])
+          (db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])
+
+          (try
+            (reduce (fn [idx file-id]
+                      (ps/acquire! sjobs)
+                      (px/run! executor (partial process-file file-id idx (dt/tpoint)))
+                      (inc idx))
+                    0
+                    (->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
+                         (take max-items)
+                         (map :id)))
+            (finally
+              ;; Close and await tasks
+              (pu/close! executor))))]
+
+    (try
+      (db/tx-run! main/system process-files)
+
+      (catch Throwable cause
+        (l/dbg :hint "process:error" :cause cause))
+
+      (finally
+        (let [elapsed (dt/format-duration (tpoint))]
+          (l/dbg :hint "process:end"
+                 :rollback rollback?
+                 :elapsed elapsed))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MISC

backend/src/app/tasks/tasks_gc.clj

@@ -16,8 +16,7 @@
 
 (def ^:private
   sql:delete-completed-tasks
-  "delete from task_completed
+  "DELETE FROM task WHERE scheduled_at < now() - ?::interval")
-    where scheduled_at < now() - ?::interval")
 
 (defmethod ig/pre-init-spec ::handler [_]
   (s/keys :req [::db/pool]))

common/src/app/common/data.cljc

@@ -242,7 +242,12 @@
   ([]
    (remove (comp qualified-keyword? key)))
   ([data]
-   (into {} (without-qualified) data)))
+   (reduce-kv (fn [data k _]
+                (if (qualified-keyword? k)
+                  (dissoc data k)
+                  data))
+              data
+              data)))
 
 (defn without-keys
   "Return a map without the keys provided

common/src/app/common/media.cljc

@@ -58,6 +58,7 @@
     "application/zip"    ".zip"
     "application/penpot" ".penpot"
     "application/pdf"    ".pdf"
+    "text/plain"         ".txt"
     nil))
 
 (s/def ::id uuid?)

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

@@ -302,13 +302,19 @@
          objects         (:objects container)
          unames          (volatile! (cfh/get-used-names objects))
 
+         component-children
+         (d/index-by :id (cfh/get-children-with-self objects (:id component-shape)))
+
          frame-id        (or force-frame-id
                              (ctst/get-frame-id-by-position objects
                                                             (gpt/add orig-pos delta)
                                                             {:skip-components? true
-                                                             :bottom-frames? true}))
+                                                             :bottom-frames? true
+                                                             ;; We must avoid that destiny frame is inside the component frame
+                                                             :validator #(nil? (get component-children (:id %)))}))
+
          frame           (get-shape container frame-id)
-         component-frame (get-component-shape (:objects container) frame {:allow-main? true})
+         component-frame (get-component-shape objects frame {:allow-main? true})
 
          ids-map         (volatile! {})
 

common/src/app/common/types/shape_tree.cljc

@@ -276,9 +276,12 @@
     (gpt/point? position))
 
    (let [frames    (get-frames objects options)
-         frames    (sort-z-index-objects objects frames options)]
+         frames    (sort-z-index-objects objects frames options)
+         ;; Validator is a callback to add extra conditions to the suggested frame
+         validator (or (get options :validator) #(-> true))]
      (or (d/seek #(and ^boolean (some? position)
-                       ^boolean (gsh/has-point? % position))
+                       ^boolean (gsh/has-point? % position)
+                       ^boolean (validator %))
                  frames)
          (get objects uuid/zero)))))
 

frontend/src/app/main/data/workspace/colors.cljs

@@ -439,6 +439,23 @@
           (rx/of (change-stroke ids (merge uc/empty-color color) 0))
           (rx/of (change-fill ids (merge uc/empty-color color) 0)))))))
 
+(declare activate-colorpicker-color)
+(declare activate-colorpicker-gradient)
+(declare activate-colorpicker-image)
+
+(defn apply-color-from-colorpicker
+  [color]
+  (ptk/reify ::apply-color-from-colorpicker
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (rx/of
+       (cond
+         (:image color) (activate-colorpicker-image)
+         (:color color) (activate-colorpicker-color)
+         (= :linear (get-in color [:gradient :type])) (activate-colorpicker-gradient :linear-gradient)
+         (= :radial (get-in color [:gradient :type])) (activate-colorpicker-gradient :radial-gradient))
+       (apply-color-from-palette color false)))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; COLORPICKER STATE MANAGEMENT

frontend/src/app/main/data/workspace/libraries_helpers.cljs

@@ -161,9 +161,7 @@
                                       component
                                       (:data library)
                                       position
-                                      components-v2
+                                      components-v2)
-                                      ;; The position can generate a frame calculation inside the base component so we force the frame-id
-                                      {:force-frame-id frame-id})
 
          first-shape (cond-> (first new-shapes)
                        (not (nil? parent-id))

frontend/src/app/main/data/workspace/persistence.cljs

@@ -16,7 +16,6 @@
    [app.main.features :as features]
    [app.main.repo :as rp]
    [app.main.store :as st]
-   [app.util.router :as rt]
    [app.util.time :as dt]
    [beicon.v2.core :as rx]
    [okulary.core :as l]
@@ -177,19 +176,11 @@
 
                              (rx/of (shapes-changes-persisted-finished))))))
              (rx/catch (fn [cause]
-                         (cond
+                         (if (instance? js/TypeError cause)
-                           (= :authentication (:type cause))
-                           (rx/throw cause)
-
-                           (instance? js/TypeError cause)
                            (->> (rx/timer 2000)
                                 (rx/map (fn [_]
                                           (persist-changes file-id file-revn changes pending-commits))))
-
+                           (rx/throw cause)))))))))
-                           :else
-                           (rx/concat
-                            (rx/of (rt/assign-exception cause))
-                            (rx/throw cause))))))))))
 
 ;; Event to be thrown after the changes have been persisted
 (defn shapes-changes-persisted-finished

frontend/src/app/main/errors.cljs

@@ -116,7 +116,6 @@
 
 (defmethod ptk/handle-error :validation
   [{:keys [code] :as error}]
-
   (print-group! "Validation Error"
                 (fn []
                   (print-data! error)
@@ -130,12 +129,7 @@
                   :timeout 3000})))
 
     :else
-    (let [message (tr "errors.generic-validation")]
+    (st/async-emit! (rt/assign-exception error))))
-      (st/async-emit!
-       (msg/show {:content message
-                  :type :error
-                  :timeout 3000})))))
-
 
 
 ;; This is a pure frontend error that can be caused by an active
@@ -256,12 +250,7 @@
 
 (defmethod ptk/handle-error :server-error
   [error]
-  (ts/schedule
+  (st/async-emit! (rt/assign-exception error))
-   #(st/emit!
-     (msg/show {:content "Something wrong has happened (on backend)."
-                :type :error
-                :timeout 3000})))
-
   (print-group! "Server Error"
                 (fn []
                   (print-data! (dissoc error :data))

frontend/src/app/main/repo.cljs

@@ -23,28 +23,31 @@
     (rx/of nil)
 
     (= 502 status)
-    (rx/throw {:type :bad-gateway})
+    (rx/throw (ex-info "http error" {:type :bad-gateway}))
 
     (= 503 status)
-    (rx/throw {:type :service-unavailable})
+    (rx/throw (ex-info "http error" {:type :service-unavailable}))
 
     (= 0 (:status response))
-    (rx/throw {:type :offline})
+    (rx/throw (ex-info "http error" {:type :offline}))
 
     (= 200 status)
     (rx/of body)
 
     (= 413 status)
-    (rx/throw {:type :validation
+    (rx/throw (ex-info "http error"
-               :code :request-body-too-large})
+                       {:type :validation
+                        :code :request-body-too-large}))
 
     (and (>= status 400) (map? body))
-    (rx/throw body)
+    (rx/throw (ex-info "http error" body))
 
     :else
-    (rx/throw {:type :unexpected-error
+    (rx/throw
+     (ex-info "http error"
+              {:type :unexpected-error
                :status status
-               :data body})))
+               :data body}))))
 
 (def default-options
   {:update-file {:query-params [:id]}

frontend/src/app/main/store.cljs

@@ -58,22 +58,22 @@
 
 (defonce last-events
   (let [buffer  (atom [])
-        allowed #{:app.main.data.workspace/initialize-page
+        omitset #{:potok.v2.core/undefined
-                  :app.main.data.workspace/finalize-page
+                  :app.main.data.workspace.persistence/update-persistence-status
-                  :app.main.data.workspace/initialize-file
+                  :app.main.data.websocket/send-message
-                  :app.main.data.workspace/finalize-file}]
+                  :app.main.data.workspace.notifications/handle-pointer-send
+                  :app.util.router/assign-exception}]
     (->> (rx/merge
           (->> stream
                (rx/filter (ptk/type? :app.main.data.workspace.changes/commit-changes))
-               (rx/map #(-> % deref :hint-origin str))
+               (rx/map #(-> % deref :hint-origin)))
-               (rx/pipe (rxo/distinct-contiguous)))
+          (rx/map ptk/type stream))
-          (->> stream
+         (rx/filter #(not (contains? omitset %)))
-               (rx/map ptk/type)
+         (rx/map str)
-               (rx/filter #(contains? allowed %))
+         (rx/pipe (rxo/distinct-contiguous))
-               (rx/map str)))
          (rx/scan (fn [buffer event]
                     (cond-> (conj buffer event)
-                      (> (count buffer) 20)
+                      (> (count buffer) 50)
                       (pop)))
                   #queue [])
          (rx/subs! #(reset! buffer (vec %))))

frontend/src/app/main/ui.cljs

@@ -128,12 +128,11 @@
              {:keys [file-id]} path-params]
          [:? {}
           (if (:token query-params)
-            [:> static/static-header {}
+            [:> static/error-container {}
              [:div.image i/unchain]
              [:div.main-message (tr "viewer.breaking-change.message")]
              [:div.desc-message (tr "viewer.breaking-change.description")]]
 
-
             [:& viewer-page
              {:page-id page-id
               :file-id file-id

frontend/src/app/main/ui/components/color_bullet_new.cljs

@@ -13,6 +13,37 @@
    [cuerdas.core :as str]
    [rumext.v2 :as mf]))
 
+(defn- color-title
+  [color-item]
+  (let [name (:name color-item)
+        gradient (:gradient color-item)
+        image (:image color-item)
+        color (:color color-item)]
+
+    (if (some? name)
+      (cond
+        (some? color)
+        (str/ffmt "% (%)" name color)
+
+        (some? gradient)
+        (str/ffmt "% (%)" name (uc/gradient-type->string (:type gradient)))
+
+        (some? image)
+        (str/ffmt "% (%)" name (tr "media.image"))
+
+        :else
+        name)
+
+      (cond
+        (some? color)
+        color
+
+        (some? gradient)
+        (uc/gradient-type->string (:type gradient))
+
+        (some? image)
+        (tr "media.image")))))
+
 (mf/defc color-bullet
   {::mf/wrap [mf/memo]
    ::mf/wrap-props false}
@@ -28,7 +59,7 @@
     (if (uc/multiple? color)
       [:div {:class (stl/css :color-bullet :multiple)
              :on-click on-click
-             :title (:color color)}]
+             :title (color-title color)}]
       ;; No multiple selection
       (let [color    (if (string? color) {:color color :opacity 1} color)
             id       (:id color)
@@ -47,7 +78,7 @@
                   :read-only read-only?)
           :data-readonly (str read-only?)
           :on-click on-click
-          :title (:color color)}
+          :title (color-title color)}
 
          (cond
            (some? gradient)

frontend/src/app/main/ui/components/forms.cljs

@@ -286,13 +286,17 @@
 
 (mf/defc submit-button*
   {::mf/wrap-props false}
-  [{:keys [on-click children label form class name disabled] :as props}]
+  [{:keys [on-click children label form class name disabled large?] :as props}]
   (let [form      (or form (mf/use-ctx form-ctx))
 
         disabled? (or (and (some? form) (not (:valid @form)))
                       (true? disabled))
 
-        class     (dm/str (d/nilv class "btn-primary btn-large")
+        large?    (d/nilv large? true)
+
+        class     (dm/str (d/nilv class "btn-primary")
+                          " "
+                          (if large? "btn-large" "")
                           " "
                           (if disabled? (stl/css :btn-disabled) ""))
 

frontend/src/app/main/ui/components/select.cljs

@@ -15,6 +15,7 @@
    [app.util.dom :as dom]
    [rumext.v2 :as mf]))
 
+
 (defn- as-key-value
   [item]
   (if (map? item)
@@ -37,6 +38,10 @@
         current-label  (get label-index current-value)
         is-open?       (:is-open? state)
 
+        dropdown-element* (mf/use-ref nil)
+        dropdown-direction* (mf/use-state "down")
+        dropdown-direction-change* (mf/use-ref 0)
+
         open-dropdown
         (mf/use-fn
          (mf/deps disabled)
@@ -81,6 +86,13 @@
     (mf/with-effect [default-value]
       (swap! state* assoc :current-value default-value))
 
+    (mf/with-effect [is-open? dropdown-element*]
+      (let [dropdown-element (mf/ref-val dropdown-element*)]
+        (when (and (= 0 (mf/ref-val dropdown-direction-change*)) dropdown-element)
+          (let [is-outside? (dom/is-element-outside? dropdown-element)]
+            (reset! dropdown-direction* (if is-outside? "up" "down"))
+            (mf/set-ref-val! dropdown-direction-change* (inc (mf/ref-val dropdown-direction-change*)))))))
+
     (let [selected-option (first (filter #(= (:value %) default-value) options))
           current-icon (:icon selected-option)
           current-icon-ref (i/key->icon current-icon)]
@@ -93,7 +105,7 @@
        [:span {:class (stl/css :current-label)} current-label]
        [:span {:class (stl/css :dropdown-button)} i/arrow-refactor]
        [:& dropdown {:show is-open? :on-close close-dropdown}
-        [:ul {:class (dm/str dropdown-class " " (stl/css :custom-select-dropdown))}
+        [:ul {:ref dropdown-element* :data-direction @dropdown-direction* :class (dm/str dropdown-class " " (stl/css :custom-select-dropdown))}
          (for [[index item] (d/enumerate options)]
            (if (= :separator item)
              [:li {:class (dom/classnames (stl/css :separator) true)

frontend/src/app/main/ui/components/select.scss

@@ -51,6 +51,12 @@
       border-top: $s-1 solid var(--dropdown-separator-color);
     }
   }
+
+  .custom-select-dropdown[data-direction="up"] {
+    bottom: $s-32;
+    top: auto;
+  }
+
   .checked-element {
     @extend .dropdown-element-base;
     .icon {

frontend/src/app/main/ui/settings/access_tokens.cljs

@@ -176,7 +176,7 @@
                      :value (tr "labels.cancel")
                      :on-click #(modal/hide!)}]
             [:> fm/submit-button*
-             {:label (tr "modals.create-access-token.submit-label")}]])]]]]]))
+             {:large? false :label (tr "modals.create-access-token.submit-label")}]])]]]]]))
 
 (mf/defc access-tokens-hero
   []

frontend/src/app/main/ui/static.cljs

@@ -7,19 +7,21 @@
 (ns app.main.ui.static
   (:require-macros [app.main.style :as stl])
   (:require
+   [app.common.data :as d]
+   [app.common.pprint :as pp]
    [app.main.store :as st]
    [app.main.ui.icons :as i]
+   [app.util.dom :as dom]
    [app.util.globals :as globals]
    [app.util.i18n :refer [tr]]
-   [app.util.object :as obj]
    [app.util.router :as rt]
+   [app.util.webapi :as wapi]
    [rumext.v2 :as mf]))
 
-(mf/defc static-header
+(mf/defc error-container
   {::mf/wrap-props false}
-  [props]
+  [{:keys [children]}]
-  (let [children (obj/get props "children")
+  (let [on-click (mf/use-callback #(set! (.-href globals/location) "/"))]
-        on-click (mf/use-callback #(set! (.-href globals/location) "/"))]
     [:section {:class (stl/css :exception-layout)}
      [:button
       {:class (stl/css :exception-header)
@@ -34,13 +36,13 @@
 
 (mf/defc invalid-token
   []
-  [:> static-header {}
+  [:> error-container {}
    [:div {:class (stl/css :main-message)} (tr "errors.invite-invalid")]
    [:div {:class (stl/css :desc-message)} (tr "errors.invite-invalid.info")]])
 
 (mf/defc not-found
   []
-  [:> static-header {}
+  [:> error-container {}
    [:div {:class (stl/css :main-message)} (tr "labels.not-found.main-message")]
    [:div {:class (stl/css :desc-message)} (tr "labels.not-found.desc-message")]])
 
@@ -49,7 +51,7 @@
   (let [handle-retry
         (mf/use-callback
          (fn [] (st/emit! (rt/assign-exception nil))))]
-    [:> static-header {}
+    [:> error-container {}
      [:div {:class (stl/css :main-message)} (tr "labels.bad-gateway.main-message")]
      [:div {:class (stl/css :desc-message)} (tr "labels.bad-gateway.desc-message")]
      [:div {:class (stl/css :sign-info)}
@@ -57,27 +59,88 @@
 
 (mf/defc service-unavailable
   []
-  (let [handle-retry
+  (let [on-click (mf/use-fn #(st/emit! (rt/assign-exception nil)))]
-        (mf/use-callback
+    [:> error-container {}
-         (fn [] (st/emit! (rt/assign-exception nil))))]
-    [:> static-header {}
      [:div {:class (stl/css :main-message)} (tr "labels.service-unavailable.main-message")]
      [:div {:class (stl/css :desc-message)} (tr "labels.service-unavailable.desc-message")]
      [:div {:class (stl/css :sign-info)}
-      [:button {:on-click handle-retry} (tr "labels.retry")]]]))
+      [:button {:on-click on-click} (tr "labels.retry")]]]))
+
+
+(defn generate-report
+  [data]
+  (let [team-id    (:current-team-id @st/state)
+        profile-id (:profile-id @st/state)
+
+        trace      (:app.main.errors/trace data)
+        instance   (:app.main.errors/instance data)
+        content    (with-out-str
+                     (println "Hint:   " (or (:hint data) (ex-message instance) "--"))
+                     (println "Prof ID:" (str (or profile-id "--")))
+                     (println "Team ID:" (str (or team-id "--")))
+
+                     (when-let [file-id (:file-id data)]
+                       (println "File ID:" (str file-id)))
+
+                     (println)
+
+                     (println "Data:")
+                     (loop [data data]
+                       (-> (d/without-qualified data)
+                           (dissoc :explain)
+                           (d/update-when :data (constantly "(...)"))
+                           (pp/pprint {:level 8 :length 10}))
+
+                       (println)
+
+                       (when-let [explain (:explain data)]
+                         (print explain))
+
+                       (when (and (= :server-error (:type data))
+                                  (contains? data :data))
+                         (recur (:data data))))
+
+                     (println "Trace:")
+                     (println trace)
+                     (println)
+
+                     (println "Last events:")
+                     (pp/pprint @st/last-events {:length 200})
+
+                     (println))]
+
+    (wapi/create-blob content "text/plain")))
+
 
 (mf/defc internal-error
-  []
+  {::mf/props :obj}
-  (let [handle-retry
+  [{:keys [data]}]
-        (mf/use-callback
+  (let [on-click   (mf/use-fn #(st/emit! (rt/assign-exception nil)))
-         (fn [] (st/emit! (rt/assign-exception nil))))]
+        report-uri (mf/use-ref nil)
-    [:> static-header {}
+
+        on-download
+        (mf/use-fn
+         (fn [event]
+           (dom/prevent-default event)
+           (when-let [uri (mf/ref-val report-uri)]
+             (dom/trigger-download-uri "report" "text/plain" uri))))]
+
+    (mf/with-effect [data]
+      (let [report (generate-report data)
+            uri    (wapi/create-uri report)]
+        (mf/set-ref-val! report-uri uri)
+        (fn []
+          (wapi/revoke-uri uri))))
+
+    [:> error-container {}
      [:div {:class (stl/css :main-message)} (tr "labels.internal-error.main-message")]
      [:div {:class (stl/css :desc-message)} (tr "labels.internal-error.desc-message")]
+     [:a {:on-click on-download} "Download report.txt"]
      [:div {:class (stl/css :sign-info)}
-      [:button {:on-click handle-retry} (tr "labels.retry")]]]))
+      [:button {:on-click on-click} (tr "labels.retry")]]]))
 
 (mf/defc exception-page
+  {::mf/props :obj}
   [{:keys [data] :as props}]
   (case (:type data)
     :not-found
@@ -89,4 +152,4 @@
     :service-unavailable
     [:& service-unavailable]
 
-    [:& internal-error]))
+    [:> internal-error props]))

frontend/src/app/main/ui/workspace/colorpicker.cljs

@@ -144,50 +144,8 @@
 
         on-select-library-color
         (mf/use-fn
-         (fn [state color]
+         (fn [_ color]
-           (let [type-origin selected-mode
+           (st/emit! (dc/apply-color-from-colorpicker color))))
-                 editig-stop-origin (:editing-stop state)
-                 is-gradient? (some? (:gradient color))
-                 change-to (fn [new-color]
-                             (st/emit! (dc/update-colorpicker new-color))
-                             (on-change new-color))
-                 clean-stop (fn [stops index color]
-                              (-> (nth stops index)
-                                  (merge color)
-                                  (assoc :offset index)
-                                  (dissoc :r)
-                                  (dissoc :g)
-                                  (dissoc :b)
-                                  (dissoc :alpha)
-                                  (dissoc :s)
-                                  (dissoc :h)
-                                  (dissoc :v)
-                                  (dissoc :hex)))
-                 set-new-gradient (fn [state color index]
-                                    (let [old-stops (:stops state)
-                                          old-gradient (:gradient state)
-                                          new-gradient (-> old-gradient
-                                                           (cond-> (= index 0) (assoc  :stops [(clean-stop old-stops 0 color) (nth old-stops 1)]))
-                                                           (cond-> (= index 1) (assoc  :stops [(nth old-stops 0) (clean-stop old-stops 1 color)]))
-                                                           (dissoc :shape-id))]
-                                      (change-to {:gradient new-gradient})))
-                 new-mode (cond
-                            (:image color) :image
-                            (:color color) :color
-                            (= :linear (get-in color [:gradient :type])) :linear-gradient
-                            (= :radial (get-in color [:gradient :type])) :radial-gradient)]
-             ;; If we have any kind of gradient and:
-             ;; Click on a solid color -> This color is applied to the selected offset
-             ;; Click on a color with transparency -> The same to solid color will happend
-             ;; Click on any kind of gradient -> The color changes completly to new gradient
-
-             ;; If we have a non gradient color the new color is applied without any change
-             (if (or (= :radial-gradient type-origin) (= :linear-gradient type-origin))
-               (if is-gradient?
-                 (change-to color)
-                 (set-new-gradient state color editig-stop-origin))
-               (change-to color))
-             (handle-change-mode new-mode))))
 
         on-add-library-color
         (mf/use-fn
@@ -384,20 +342,27 @@
         rulers? (mf/deref refs/rulers?)
         left-offset (if rulers? 40 18)
 
-        x-pos   400]
+        x-pos 400]
+
     (cond
-      (or (nil? x) (nil? y)) {:left "auto" :right "16rem" :top "4rem"}
+      (or (nil? x) (nil? y)) #js {:left "auto" :right "16rem" :top "4rem"}
       (= position :left)
       (if (> y max-y)
-        {:left (str (- x x-pos) "px")
+        #js {:left (str (- x x-pos) "px")
-         :bottom "1rem"}
+             :bottom "1rem"}
-        {:left (str (- x x-pos) "px")
+        #js {:left (str (- x x-pos) "px")
-         :top (str (- y 70) "px")})
+             :top (str (- y 70) "px")})
+      (= position :right)
+      (if (> y max-y)
+        #js {:left (str (+ x 80) "px")
+             :bottom "1rem"}
+        #js {:left (str (+ x 80) "px")
+             :top (str (- y 70) "px")})
       :else (if (> y max-y)
-              {:left (str (+ x left-offset) "px")
+              #js {:left (str (+ x left-offset) "px")
-               :bottom "1rem"}
+                   :bottom "1rem"}
-              {:left (str (+ x left-offset) "px")
+              #js {:left (str (+ x left-offset) "px")
-               :top (str (- y 70) "px")}))))
+                   :top (str (- y 70) "px")}))))
 
 (mf/defc colorpicker-modal
   {::mf/register modal/components
@@ -428,7 +393,7 @@
           (on-close @last-change))))
 
     [:div {:class (stl/css :colorpicker-tooltip)
-           :style (clj->js style)}
+           :style style}
      [:& colorpicker {:data data
                       :disable-gradient disable-gradient
                       :disable-opacity disable-opacity

frontend/src/app/util/dom.cljs

@@ -24,6 +24,7 @@
   cljs.core/IDeref
   (-deref [it] (.getBrowserEvent it)))
 
+(declare get-window-size)
 
 (defn browser-event?
   [o]
@@ -411,6 +412,19 @@
      :width (.-width ^js rect)
      :height (.-height ^js rect)}))
 
+(defn is-bounding-rect-outside?
+  [rect]
+  (let [{:keys [left top right bottom]} rect
+        {:keys [width height]} (get-window-size)]
+    (or (< left 0)
+        (< top 0)
+        (> right width)
+        (> bottom height))))
+
+(defn is-element-outside?
+  [element]
+  (is-bounding-rect-outside? (get-bounding-rect element)))
+
 (defn bounding-rect->rect
   [rect]
   (when (some? rect)