Merge branch 'main' into staging

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

View File

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

View File

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

View File

@@ -234,7 +234,7 @@
shape))
(update-container [container]
(update container :objects d/update-vals fix-line-paths))]
(d/update-when container :objects d/update-vals fix-line-paths))]
(-> data
(update :pages-index d/update-vals update-container)
@@ -288,7 +288,9 @@
(let [[deleted objects] (clean-objects objects)]
(if (and (pos? deleted) (< n 1000))
(recur (inc n) objects)
(assoc container :objects objects)))))]
(-> container
(assoc :objects objects)
(d/without-nils))))))]
(-> data
(update :pages-index d/update-vals clean-container)
@@ -386,21 +388,20 @@
(dissoc :fill-color :fill-opacity))))
(update-container [container]
(if (contains? container :objects)
(loop [objects (:objects container)
shapes (->> (vals objects)
(filter cfh/image-shape?))]
(if-let [shape (first shapes)]
(let [{:keys [id frame-id] :as shape'} (process-shape shape)]
(if (identical? shape shape')
(recur objects (rest shapes))
(recur (-> objects
(assoc id shape')
(d/update-when frame-id dissoc :thumbnail))
(rest shapes))))
(assoc container :objects objects)))
container))]
(loop [objects (:objects container)
shapes (->> (vals objects)
(filter cfh/image-shape?))]
(if-let [shape (first shapes)]
(let [{:keys [id frame-id] :as shape'} (process-shape shape)]
(if (identical? shape shape')
(recur objects (rest shapes))
(recur (-> objects
(assoc id shape')
(d/update-when frame-id dissoc :thumbnail))
(rest shapes))))
(-> container
(assoc :objects objects)
(d/without-nils)))))]
(-> data
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
@@ -1621,6 +1622,14 @@
[data _]
(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
(into (d/ordered-set)
["legacy-2"
@@ -1691,4 +1700,5 @@
"0012-fix-position-data"
"0013-fix-component-path"
"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]
[:page-id {:optional true} [:maybe ::sm/uuid]]])
(def check-error!
(def check-error
(sm/check-fn schema:error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -99,21 +99,17 @@
(defn- report-error
[code hint shape file page & {:as args}]
(let [error {:code code
:hint hint
:shape shape
:file-id (:id file)
:page-id (:id page)
:shape-id (:id shape)
:args args}]
(let [error (d/without-nils
{:code code
:hint hint
:shape shape
:file-id (:id file)
:page-id (:id page)
:shape-id (:id shape)
:args args})]
(dm/assert!
"expected a valid `*errors*` dynamic binding"
(some? *errors*))
(dm/assert!
"expected valid error"
(check-error! error))
(assert (some? *errors*) "expected a valid `*errors*` dynamic binding")
(assert (check-error error))
(vswap! *errors* conj error)))

View File

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

View File

@@ -6,6 +6,7 @@
(ns common-tests.schema-test
(:require
[app.common.data :as d]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[clojure.test :as t]))
@@ -35,6 +36,77 @@
(t/is (true? (sm/validate schema #{})))
(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"
(let [schema [::sm/set ::sm/email]
value (sg/generate schema)]