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

CHANGES.md

@@ -102,6 +102,7 @@
 - Fix options button does not work for comments created in the lower part of the screen [Taiga #12422](https://tree.taiga.io/project/penpot/issue/12422)
 - Fix problem when checking usage with removed teams [Taiga #12442](https://tree.taiga.io/project/penpot/issue/12442)
 - Fix focus mode persisting across page/file navigation [Taiga #12469](https://tree.taiga.io/project/penpot/issue/12469)
+- Fix shadow color validation [Github #7705](https://github.com/penpot/penpot/pull/7705)
 
 ## 2.10.1
 

backend/src/app/tasks/file_gc.clj

@@ -218,6 +218,9 @@
     (when (or (nil? revn) (= revn (:revn file)))
       file)))
 
+;; FIXME: we should skip files that does not match the revn on the
+;; props and add proper schema for this task props
+
 (defn- process-file!
   [cfg {:keys [file-id] :as props}]
   (if-let [file (get-file cfg props)]

backend/src/app/tasks/file_gc_scheduler.clj

@@ -8,6 +8,7 @@
   "A maintenance task that is responsible of properly scheduling the
   file-gc task for all files that matches the eligibility threshold."
   (:require
+   [app.common.logging :as l]
    [app.common.time :as ct]
    [app.config :as cf]
    [app.db :as db]
@@ -21,25 +22,24 @@
           f.modified_at
      FROM file AS f
     WHERE f.has_media_trimmed IS false
-      AND f.modified_at < now() - ?::interval
+      AND f.modified_at < ?
       AND f.deleted_at IS NULL
     ORDER BY f.modified_at DESC
       FOR UPDATE OF f
      SKIP LOCKED")
 
-(defn- get-candidates
-  [{:keys [::db/conn ::min-age] :as cfg}]
-  (let [min-age (db/interval min-age)]
-    (db/plan conn [sql:get-candidates min-age] {:fetch-size 10})))
-
 (defn- schedule!
-  [cfg]
+  [{:keys [::db/conn] :as cfg} threshold]
   (let [total (reduce (fn [total {:keys [id modified-at revn]}]
-                        (let [params {:file-id id :modified-at modified-at :revn revn}]
+                        (let [params {:file-id id :revn revn}]
+                          (l/trc :hint "schedule"
+                                 :file-id (str id)
+                                 :revn revn
+                                 :modified-at (ct/format-inst modified-at))
                           (wrk/submit! (assoc cfg ::wrk/params params))
                           (inc total)))
                       0
-                      (get-candidates cfg))]
+                      (db/plan conn [sql:get-candidates threshold] {:fetch-size 10}))]
     {:processed total}))
 
 (defmethod ig/assert-key ::handler
@@ -53,12 +53,12 @@
 (defmethod ig/init-key ::handler
   [_ cfg]
   (fn [{:keys [props] :as task}]
-    (let [min-age (ct/duration (or (:min-age props) (::min-age cfg)))]
+    (let [threshold (-> (ct/duration (or (:min-age props) (::min-age cfg)))
+                        (ct/in-past))]
       (-> cfg
           (assoc ::db/rollback (:rollback? props))
-          (assoc ::min-age min-age)
           (assoc ::wrk/task :file-gc)
           (assoc ::wrk/priority 10)
           (assoc ::wrk/mark-retries 0)
-          (assoc ::wrk/delay 1000)
-          (db/tx-run! schedule!)))))
+          (assoc ::wrk/delay 10000)
+          (db/tx-run! schedule! threshold)))))

backend/src/app/worker.clj

@@ -77,8 +77,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def ^:private sql:insert-new-task
-  "insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at)
-   values (?, ?, ?, ?, ?, ?, ?, now() + ?)
+  "insert into task (id, name, props, queue, label, priority, max_retries, created_at, modified_at, scheduled_at)
+   values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
    returning id")
 
 (def ^:private
@@ -88,7 +88,7 @@
       AND queue=?
       AND label=?
       AND status = 'new'
-      AND scheduled_at > now()")
+      AND scheduled_at > ?")
 
 (def ^:private schema:options
   [:map {:title "submit-options"}
@@ -111,17 +111,19 @@
 
   (check-options! options)
 
-  (let [duration  (ct/duration delay)
-        interval  (db/interval duration)
-        props     (db/tjson params)
-        id        (uuid/next)
-        tenant    (cf/get :tenant)
-        task      (d/name task)
-        queue     (str/ffmt "%:%" tenant (d/name queue))
-        conn      (db/get-connectable options)
-        deleted   (when dedupe
-                    (-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
-                        :next.jdbc/update-count))]
+  (let [delay        (ct/duration delay)
+        now          (ct/now)
+        scheduled-at (-> (ct/plus now delay)
+                         (ct/truncate :millisecond))
+        props        (db/tjson params)
+        id           (uuid/next)
+        tenant       (cf/get :tenant)
+        task         (d/name task)
+        queue        (str/ffmt "%:%" tenant (d/name queue))
+        conn         (db/get-connectable options)
+        deleted      (when dedupe
+                       (-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label now])
+                           (db/get-update-count)))]
 
     (l/trc :hint "submit task"
            :name task
@@ -129,11 +131,13 @@
            :queue queue
            :label label
            :dedupe (boolean dedupe)
-           :delay (ct/format-duration duration)
+           :delay (ct/format-duration delay)
            :replace (or deleted 0))
 
     (db/exec-one! conn [sql:insert-new-task id task props queue
-                        label priority max-retries interval])
+                        label priority max-retries
+                        now now scheduled-at])
+
     id))
 
 (defn invoke!

backend/src/app/worker/runner.clj

@@ -158,7 +158,9 @@
             (inst-ms (:scheduled-at task)))
       (l/wrn :hint "skiping task, rescheduled"
              :task-id task-id
-             :runner-id id)
+             :runner-id id
+             :scheduled-at (ct/format-inst (:scheduled-at task))
+             :expected-scheduled-at (ct/format-inst scheduled-at))
 
       :else
       (let [result (run-task cfg task)]
@@ -179,7 +181,8 @@
                           {:error explain
                            :status "retry"
                            :modified-at now
-                           :scheduled-at (ct/plus now delay)
+                           :scheduled-at (-> (ct/plus now delay)
+                                             (ct/truncate :millisecond))
                            :retry-num nretry}
                           {:id (:id task)})
               nil))

backend/test/backend_tests/helpers.clj

@@ -549,6 +549,44 @@
       (io/copy r sw)
       (.toString sw))))
 
+(defn parse-sse
+  [content]
+  (let [state
+        (reduce (fn [{:keys [events data event id] :as state} line]
+                  (cond
+                    ;; empty line → dispatch event if we have data
+                    (str/blank? line)
+                    (if (seq data)
+                      (-> state
+                          (update :events conj {:event (or event "message")
+                                                :data (-> (str/join "\n" data))})
+                          (assoc :data [] :event nil))
+                      state)
+
+                    ;; comment line (starts with :)
+                    (str/starts-with? line ":")
+                    state
+
+                    :else
+                    (let [[field raw-value] (str/split line #":" 2)
+                          value (some-> raw-value (str/replace #"^ " ""))]
+                      (case field
+                        "data"  (update state :data conj (or value ""))
+                        "event" (assoc state :event value)
+                        ;; ignore retry and unknown fields
+                        state))))
+                {:events [] :data [] :event nil}
+                (str/split content #"\r?\n"))
+
+        ;; handle unterminated last event (no trailing blank line)
+        state (if (seq (:data state))
+                (update state :events conj
+                        {:event (or (:event state) "message")
+                         :data (str/join "\n" (:data state))})
+                state)]
+
+    (:events state)))
+
 (defn consume-sse
   [callback]
   (let [{:keys [::yres/status ::yres/body ::yres/headers] :as response} (callback {})
@@ -558,12 +596,9 @@
     (try
       (px/exec! :virtual #(rcp/write-body-to-stream body nil output))
       (into []
-            (map (fn [event]
-                   (let [[item1 item2] (re-seq #"(.*): (.*)\n?" event)]
-
-                     [(keyword (nth item1 2))
-                      (tr/decode-str (nth item2 2))])))
-            (-> (slurp' input)
-                (str/split "\n\n")))
+            (map (fn [{:keys [event data]}]
+                   [(keyword event)
+                    (tr/decode-str data)]))
+            (parse-sse (slurp' input)))
       (finally
         (.close input)))))

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

@@ -1357,38 +1357,6 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
-(defmethod migrate-data "0004-clean-shadow-color"
-  [data _]
-  (let [decode-color (sm/decoder types.color/schema:color sm/json-transformer)
-
-        clean-shadow-color
-        (fn [color]
-          (let [ref-id   (get color :id)
-                ref-file (get color :file-id)]
-            (-> (d/without-qualified color)
-                (select-keys [:opacity :color :gradient :image :ref-id :ref-file])
-                (cond-> ref-id
-                  (assoc :ref-id ref-id))
-                (cond-> ref-file
-                  (assoc :ref-file ref-file))
-                (decode-color))))
-
-        clean-shadow
-        (fn [shadow]
-          (update shadow :color clean-shadow-color))
-
-        update-object
-        (fn [object]
-          (d/update-when object :shadow #(mapv clean-shadow %)))
-
-        update-container
-        (fn [container]
-          (d/update-when container :objects d/update-vals update-object))]
-
-    (-> data
-        (update :pages-index d/update-vals update-container)
-        (d/update-when :components d/update-vals update-container))))
-
 (defmethod migrate-data "0005-deprecate-image-type"
   [data _]
   (letfn [(update-object [object]
@@ -1697,6 +1665,45 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+(defmethod migrate-data "0015-clean-shadow-color"
+  [data _]
+  (let [decode-shadow-color
+        (sm/decoder ctss/schema:color sm/json-transformer)
+
+        clean-shadow-color
+        (fn [color]
+          (let [ref-id   (get color :id)
+                ref-file (get color :file-id)]
+            (-> (d/without-qualified color)
+                (select-keys ctss/color-attrs)
+                (cond-> ref-id
+                  (assoc :ref-id ref-id))
+                (cond-> ref-file
+                  (assoc :ref-file ref-file))
+                (decode-shadow-color)
+                (d/without-nils))))
+
+        clean-shadow
+        (fn [shadow]
+          (update shadow :color clean-shadow-color))
+
+        clean-xform
+        (comp
+         (keep clean-shadow)
+         (filter ctss/valid-shadow?))
+
+        update-object
+        (fn [object]
+          (d/update-when object :shadow #(into [] clean-xform %)))
+
+        update-container
+        (fn [container]
+          (d/update-when container :objects d/update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 ;; Copy fills from position-data to text nodes when all text nodes lack fills,
 ;; all position-data have fills, and the counts match
 (defmethod migrate-data "0016-copy-fills-from-position-data-to-text-node"
@@ -1818,7 +1825,6 @@
          "0002-clean-shape-interactions"
          "0003-fix-root-shape"
          "0003-convert-path-content-v2"
-         "0004-clean-shadow-color"
          "0005-deprecate-image-type"
          "0006-fix-old-texts-fills"
          "0008-fix-library-colors-v4"
@@ -1832,4 +1838,5 @@
          "0014-fix-tokens-lib-duplicate-ids"
          "0014-clear-components-nil-objects"
          "0015-fix-text-attrs-blank-strings"
+         "0015-clean-shadow-color"
          "0016-copy-fills-from-position-data-to-text-node"]))

common/src/app/common/schema.cljc

@@ -36,7 +36,7 @@
 
 (defn type
   [s]
-  (m/-type s))
+  (m/type s default-options))
 
 (defn properties
   [s]
@@ -46,6 +46,10 @@
   [s]
   (m/type-properties s))
 
+(defn children
+  [s]
+  (m/children s default-options))
+
 (defn schema
   [s]
   (if (schema? s)
@@ -127,9 +131,19 @@
 
 (defn keys
   "Given a map schema, return all keys as set"
-  [schema]
-  (->> (entries schema)
-       (into #{} xf:map-key)))
+  [schema']
+  (let [schema' (m/schema schema' default-options)]
+    (case (m/type schema')
+      :map
+      (->> (entries schema')
+           (into #{} xf:map-key))
+
+      :merge
+      (->> (m/children schema')
+           (mapcat m/entries)
+           (into #{} xf:map-key))
+
+      (throw (ex-info "not supported schema type" {:type (m/type schema')})))))
 
 (defn update-properties
   [s f & args]

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

@@ -11,6 +11,14 @@
 
 (def styles #{:drop-shadow :inner-shadow})
 
+(def schema:color
+  [:merge {:title "ShadowColor"}
+   ctc/schema:color-attrs
+   ctc/schema:plain-color])
+
+(def color-attrs
+  (sm/keys schema:color))
+
 (def schema:shadow
   [:map {:title "Shadow"}
    [:id [:maybe ::sm/uuid]]
@@ -20,7 +28,7 @@
    [:blur ::sm/safe-number]
    [:spread ::sm/safe-number]
    [:hidden :boolean]
-   [:color ctc/schema:color]])
+   [:color schema:color]])
 
 (def check-shadow
   (sm/check-fn schema:shadow))