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

This commit is contained in:
Andrey Antukh 2025-10-15 11:32:15 +02:00
commit 9a5efe8671
6 changed files with 150 additions and 59 deletions

View File

@ -61,8 +61,7 @@
::yres/body data} ::yres/body data}
(binding [l/*context* (request->context request)] (binding [l/*context* (request->context request)]
(l/err :hint "restriction error" (l/wrn :hint "restriction error" :cause err)
:cause err)
{::yres/status 400 {::yres/status 400
::yres/body data})))) ::yres/body data}))))

View File

@ -15,7 +15,7 @@
[app.common.features :as cfeat] [app.common.features :as cfeat]
[app.common.files.validate :as cfv] [app.common.files.validate :as cfv]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pprint :as p] [app.common.pprint :as pp]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.time :as ct] [app.common.time :as ct]
@ -58,7 +58,7 @@
(defn print-tasks (defn print-tasks
[] []
(let [tasks (:app.worker/registry main/system)] (let [tasks (:app.worker/registry main/system)]
(p/pprint (keys tasks) :level 200))) (pp/pprint (keys tasks) :level 200)))
(defn run-task! (defn run-task!
([tname] ([tname]
@ -130,18 +130,18 @@
(defn reset-password! (defn reset-password!
"Reset a password to a specific one for a concrete user or all users "Reset a password to a specific one for a concrete user or all users
if email is `:all` keyword." if email is `:all` keyword."
[& {:keys [email password] :or {password "123123"} :as params}] [& {:keys [email password]}]
(when-not email (assert (string? email) "expected email")
(throw (IllegalArgumentException. "email is mandatory"))) (assert (string? password) "expected password")
(some-> main/system (some-> main/system
(db/tx-run! (db/tx-run!
(fn [{:keys [::db/conn] :as system}] (fn [{:keys [::db/conn] :as system}]
(let [password (derive-password password)] (let [password (derive-password password)
(if (= email :all) email (str/lower email)]
(db/exec! conn ["update profile set password=?" password]) (-> (db/exec-one! conn ["update profile set password=? where email=?" password email])
(let [email (str/lower email)] (db/get-update-count)
(db/exec! conn ["update profile set password=? where email=?" password email])))))))) (pos?)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FEATURES ;; FEATURES
@ -531,6 +531,17 @@
(assoc :max-jobs 1) (assoc :max-jobs 1)
(process!)))) (process!))))
(defn mark-file-as-trimmed
[id]
(let [id (h/parse-uuid id)]
(db/tx-run! main/system (fn [cfg]
(-> (db/update! cfg :file
{:has-media-trimmed true}
{:id id}
{::db/return-keys false})
(db/get-update-count)
(pos?))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT) ;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -234,7 +234,7 @@
shape)) shape))
(update-container [container] (update-container [container]
(update container :objects d/update-vals fix-line-paths))] (d/update-when container :objects d/update-vals fix-line-paths))]
(-> data (-> data
(update :pages-index d/update-vals update-container) (update :pages-index d/update-vals update-container)
@ -288,7 +288,9 @@
(let [[deleted objects] (clean-objects objects)] (let [[deleted objects] (clean-objects objects)]
(if (and (pos? deleted) (< n 1000)) (if (and (pos? deleted) (< n 1000))
(recur (inc n) objects) (recur (inc n) objects)
(assoc container :objects objects)))))] (-> container
(assoc :objects objects)
(d/without-nils))))))]
(-> data (-> data
(update :pages-index d/update-vals clean-container) (update :pages-index d/update-vals clean-container)
@ -386,21 +388,20 @@
(dissoc :fill-color :fill-opacity)))) (dissoc :fill-color :fill-opacity))))
(update-container [container] (update-container [container]
(if (contains? container :objects) (loop [objects (:objects container)
(loop [objects (:objects container) shapes (->> (vals objects)
shapes (->> (vals objects) (filter cfh/image-shape?))]
(filter cfh/image-shape?))] (if-let [shape (first shapes)]
(if-let [shape (first shapes)] (let [{:keys [id frame-id] :as shape'} (process-shape shape)]
(let [{:keys [id frame-id] :as shape'} (process-shape shape)] (if (identical? shape shape')
(if (identical? shape shape') (recur objects (rest shapes))
(recur objects (rest shapes)) (recur (-> objects
(recur (-> objects (assoc id shape')
(assoc id shape') (d/update-when frame-id dissoc :thumbnail))
(d/update-when frame-id dissoc :thumbnail)) (rest shapes))))
(rest shapes)))) (-> container
(assoc container :objects objects))) (assoc :objects objects)
container))] (d/without-nils)))))]
(-> data (-> data
(update :pages-index d/update-vals update-container) (update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container)))) (d/update-when :components d/update-vals update-container))))
@ -1621,6 +1622,14 @@
[data _] [data _]
(d/update-when data :tokens-lib types.tokens-lib/fix-duplicate-token-set-ids)) (d/update-when data :tokens-lib types.tokens-lib/fix-duplicate-token-set-ids))
(defmethod migrate-data "0014-clear-components-nil-objects"
[data _]
;; Because of a bug in migrations, several files have migrations
;; applied in an incorrect order and because of other bug on old
;; migrations, some files have components with `:objects` with `nil`
;; as value; this migration fixes it.
(d/update-when data :components d/update-vals d/without-nils))
(def available-migrations (def available-migrations
(into (d/ordered-set) (into (d/ordered-set)
["legacy-2" ["legacy-2"
@ -1691,4 +1700,5 @@
"0012-fix-position-data" "0012-fix-position-data"
"0013-fix-component-path" "0013-fix-component-path"
"0013-clear-invalid-strokes-and-fills" "0013-clear-invalid-strokes-and-fills"
"0014-fix-tokens-lib-duplicate-ids"])) "0014-fix-tokens-lib-duplicate-ids"
"0014-clear-components-nil-objects"]))

View File

@ -83,7 +83,7 @@
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:page-id {:optional true} [:maybe ::sm/uuid]]]) [:page-id {:optional true} [:maybe ::sm/uuid]]])
(def check-error! (def check-error
(sm/check-fn schema:error)) (sm/check-fn schema:error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -99,21 +99,17 @@
(defn- report-error (defn- report-error
[code hint shape file page & {:as args}] [code hint shape file page & {:as args}]
(let [error {:code code (let [error (d/without-nils
:hint hint {:code code
:shape shape :hint hint
:file-id (:id file) :shape shape
:page-id (:id page) :file-id (:id file)
:shape-id (:id shape) :page-id (:id page)
:args args}] :shape-id (:id shape)
:args args})]
(dm/assert! (assert (some? *errors*) "expected a valid `*errors*` dynamic binding")
"expected a valid `*errors*` dynamic binding" (assert (check-error error))
(some? *errors*))
(dm/assert!
"expected valid error"
(check-error! error))
(vswap! *errors* conj error))) (vswap! *errors* conj error)))

View File

@ -423,38 +423,41 @@
(fn [{:keys [kind max min ordered] :as props} children _] (fn [{:keys [kind max min ordered] :as props} children _]
(let [kind (or (last children) kind) (let [kind (or (last children) kind)
pred child-pred
(cond (cond
(fn? kind) kind (fn? kind) kind
(nil? kind) any? (nil? kind) any?
:else (validator kind)) :else (validator kind))
type-pred
(if ordered
d/ordered-set?
set?)
pred pred
(cond (cond
(and max min) (and max min)
(fn [value] (fn [value]
(let [size (count value)] (and (type-pred value)
(and (set? value) (every? child-pred value)
(<= min size max) (<= min (count value) max)))
(every? pred value))))
min min
(fn [value] (fn [value]
(let [size (count value)] (and (type-pred value)
(and (set? value) (every? child-pred value)
(<= min size) (<= min (count value))))
(every? pred value))))
max max
(fn [value] (fn [value]
(let [size (count value)] (and (type-pred value)
(and (set? value) (every? child-pred value)
(<= size max) (<= (count value) max)))
(every? pred value))))
:else :else
(fn [value] (fn [value]
(every? pred value))) (and (type-pred value)
(every? child-pred value))))
empty-set empty-set
(if ordered (if ordered

View File

@ -6,6 +6,7 @@
(ns common-tests.schema-test (ns common-tests.schema-test
(:require (:require
[app.common.data :as d]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.generators :as sg] [app.common.schema.generators :as sg]
[clojure.test :as t])) [clojure.test :as t]))
@ -35,6 +36,77 @@
(t/is (true? (sm/validate schema #{}))) (t/is (true? (sm/validate schema #{})))
(t/is (false? (sm/validate schema #{"a"}))))) (t/is (false? (sm/validate schema #{"a"})))))
(t/testing "validate 2"
(let [candidate-1 ["a@b.com" "a@c.net"]
candidate-2 (into #{} candidate-1)
candidate-3 (into (d/ordered-set) candidate-1)
candidate-4 #{"a@b.com"}
candidate-5 (d/ordered-set "a@b.com")
schema-1 [::sm/set ::sm/email]
schema-2 [::sm/set {:ordered true} ::sm/email]
schema-3 [::sm/set {:ordered true :min 1} ::sm/email]
schema-4 [::sm/set {:min 1} ::sm/email]
schema-5 [::sm/set {:ordered true :max 1} ::sm/email]
schema-6 [::sm/set {:ordered true :min 1 :max 2} ::sm/email]
schema-7 [::sm/set {:min 1 :max 2} ::sm/email]]
(t/is (false? (sm/validate schema-1 [])))
(t/is (false? (sm/validate schema-1 candidate-1)))
(t/is (true? (sm/validate schema-1 candidate-2)))
(t/is (true? (sm/validate schema-1 candidate-3)))
(t/is (false? (sm/validate schema-2 [])))
(t/is (false? (sm/validate schema-2 candidate-1)))
(t/is (false? (sm/validate schema-2 candidate-2)))
(t/is (true? (sm/validate schema-2 candidate-3)))
(t/is (false? (sm/validate schema-3 [])))
(t/is (false? (sm/validate schema-3 candidate-1)))
(t/is (false? (sm/validate schema-3 candidate-2)))
(t/is (true? (sm/validate schema-3 candidate-3)))
(t/is (false? (sm/validate schema-3 candidate-4)))
(t/is (true? (sm/validate schema-3 candidate-5)))
(t/is (false? (sm/validate schema-3 (d/ordered-set))))
(t/is (false? (sm/validate schema-4 [])))
(t/is (false? (sm/validate schema-4 candidate-1)))
(t/is (true? (sm/validate schema-4 candidate-2)))
(t/is (true? (sm/validate schema-4 candidate-3)))
(t/is (true? (sm/validate schema-4 candidate-4)))
(t/is (true? (sm/validate schema-4 candidate-5)))
(t/is (false? (sm/validate schema-4 (d/ordered-set))))
(t/is (false? (sm/validate schema-4 #{})))
(t/is (false? (sm/validate schema-5 [])))
(t/is (false? (sm/validate schema-5 candidate-1)))
(t/is (false? (sm/validate schema-5 candidate-2)))
(t/is (false? (sm/validate schema-5 candidate-3)))
(t/is (false? (sm/validate schema-5 candidate-4)))
(t/is (true? (sm/validate schema-5 candidate-5)))
(t/is (true? (sm/validate schema-5 (d/ordered-set))))
(t/is (false? (sm/validate schema-5 #{})))
(t/is (false? (sm/validate schema-6 [])))
(t/is (false? (sm/validate schema-6 candidate-1)))
(t/is (false? (sm/validate schema-6 candidate-2)))
(t/is (true? (sm/validate schema-6 candidate-3)))
(t/is (false? (sm/validate schema-6 candidate-4)))
(t/is (true? (sm/validate schema-6 candidate-5)))
(t/is (false? (sm/validate schema-6 (d/ordered-set))))
(t/is (false? (sm/validate schema-6 #{})))
(t/is (false? (sm/validate schema-6 (conj candidate-3 "r@r.com"))))
(t/is (false? (sm/validate schema-7 [])))
(t/is (false? (sm/validate schema-7 candidate-1)))
(t/is (true? (sm/validate schema-7 candidate-2)))
(t/is (true? (sm/validate schema-7 candidate-3)))
(t/is (true? (sm/validate schema-7 candidate-4)))
(t/is (true? (sm/validate schema-7 candidate-5)))
(t/is (false? (sm/validate schema-7 (d/ordered-set))))
(t/is (false? (sm/validate schema-7 #{})))
(t/is (false? (sm/validate schema-7 (conj candidate-2 "r@r.com"))))
(t/is (false? (sm/validate schema-7 (conj candidate-3 "r@r.com"))))))
(t/testing "generate" (t/testing "generate"
(let [schema [::sm/set ::sm/email] (let [schema [::sm/set ::sm/email]
value (sg/generate schema)] value (sg/generate schema)]