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

This commit is contained in:
Andrey Antukh 2025-01-27 12:12:46 +01:00
commit 74bdd72d2f
8 changed files with 369 additions and 82 deletions

View file

@ -12,6 +12,7 @@
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.helpers :as cfh]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as fval]
[app.common.logging :as l]
@ -29,7 +30,6 @@
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.set :as set]
[clojure.walk :as walk]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[datoteka.io :as io]))
@ -251,40 +251,65 @@
:data nil}
{::sql/columns [:media-id :file-id :revn]}))
(def ^:private sql:get-missing-media-references
"SELECT fmo.*
FROM file_media_object AS fmo
WHERE fmo.id = ANY(?::uuid[])
AND file_id != ?")
(def ^:private
xform:collect-media-id
(comp
(map :objects)
(mapcat vals)
(mapcat (fn [obj]
;; NOTE: because of some bug, we ended with
;; many shape types having the ability to
;; have fill-image attribute (which initially
;; designed for :path shapes).
(sequence
(keep :id)
(concat [(:fill-image obj)
(:metadata obj)]
(map :fill-image (:fills obj))
(map :stroke-image (:strokes obj))
(->> (:content obj)
(tree-seq map? :children)
(mapcat :fills)
(map :fill-image))))))))
(defn update-media-references!
"Given a file and a coll of media-refs, check if all provided
references are correct or fix them in-place"
[{:keys [::db/conn] :as cfg} {file-id :id :as file} media-refs]
(let [missing-index
(reduce (fn [result {:keys [id] :as fmo}]
(assoc result id
(-> fmo
(assoc :id (uuid/next))
(assoc :file-id file-id)
(dissoc :created-at)
(dissoc :deleted-at))))
{}
(db/exec! conn [sql:get-missing-media-references
(->> (into #{} xf-map-id media-refs)
(db/create-array conn "uuid"))
file-id]))
(defn collect-used-media
"Given a fdata (file data), returns all media references."
[data]
(-> #{}
(into xform:collect-media-id (vals (:pages-index data)))
(into xform:collect-media-id (vals (:components data)))
(into (keys (:media data)))))
lookup-index
(fn [id]
(if-let [mobj (get missing-index id)]
(do
(l/trc :hint "lookup index"
:file-id (str file-id)
:snap-id (str (:snapshot-id file))
:id (str id)
:result (str (get mobj :id)))
(get mobj :id))
id))
update-shapes
(fn [data {:keys [page-id shape-id]}]
(d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-media-refs lookup-index))
file
(update file :data #(reduce update-shapes % media-refs))]
(doseq [[old-id item] missing-index]
(l/dbg :hint "create missing references"
:file-id (str file-id)
:snap-id (str (:snapshot-id file))
:old-id (str old-id)
:id (str (:id item)))
(db/insert! conn :file-media-object item
{::db/return-keys false}))
file))
(defn get-file-media
[cfg {:keys [data id] :as file}]
(db/run! cfg (fn [{:keys [::db/conn]}]
(let [ids (collect-used-media data)
(let [ids (cfh/collect-used-media data)
ids (db/create-array conn "uuid" ids)
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")]
@ -337,48 +362,7 @@
replace the old :component-file reference with the new
ones, using the provided file-index."
[data]
(letfn [(process-map-form [form]
(cond-> form
;; Relink image shapes
(and (map? (:metadata form))
(= :image (:type form)))
(update-in [:metadata :id] lookup-index)
;; Relink paths with fill image
(map? (:fill-image form))
(update-in [:fill-image :id] lookup-index)
;; This covers old shapes and the new :fills.
(uuid? (:fill-color-ref-file form))
(update :fill-color-ref-file lookup-index)
;; This covers the old shapes and the new :strokes
(uuid? (:stroke-color-ref-file form))
(update :stroke-color-ref-file lookup-index)
;; This covers all text shapes that have typography referenced
(uuid? (:typography-ref-file form))
(update :typography-ref-file lookup-index)
;; This covers the component instance links
(uuid? (:component-file form))
(update :component-file lookup-index)
;; This covers the shadows and grids (they have directly
;; the :file-id prop)
(uuid? (:file-id form))
(update :file-id lookup-index)))
(process-form [form]
(if (map? form)
(try
(process-map-form form)
(catch Throwable cause
(l/warn :hint "failed form" :form (pr-str form) ::l/sync? true)
(throw cause)))
form))]
(walk/postwalk process-form data)))
(cfh/relink-media-refs data lookup-index))
(defn- relink-media
"A function responsible of process the :media attr of file data and

View file

@ -6,6 +6,7 @@
(ns app.rpc.commands.files-update
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
@ -415,19 +416,37 @@
(l/error :hint "file validation error"
:cause cause))))
(defn- process-changes-and-validate
[cfg file changes skip-validate]
(let [;; WARNING: this ruins performance; maybe we need to find
;; some other way to do general validation
libs (when (and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
(get-file-libraries cfg file))
libs
(when (and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
(get-file-libraries cfg file))
file (-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils))]
;; The main purpose of this atom is provide a contextual state
;; for the changes subsystem where optionally some hints can
;; be provided for the changes processing. Right now we are
;; using it for notify about the existence of media refs when
;; a new shape is added.
state
(atom {})
file
(binding [cpc/*state* state]
(-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils)))
file
(if-let [media-refs (-> @state :media-refs not-empty)]
(bfc/update-media-references! cfg file media-refs)
file)]
(binding [pmap/*tracked* nil]
(when (contains? cf/flags :soft-file-validation)

View file

@ -53,7 +53,7 @@
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)
used (cfh/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])

View file

@ -10,7 +10,7 @@
file is eligible to be garbage collected after some period of
inactivity (the default threshold is 72h)."
(:require
[app.binfile.common :as bfc]
[app.common.files.helpers :as cfh]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as cfv]
[app.common.logging :as l]
@ -54,7 +54,7 @@
(def ^:private xf:collect-used-media
(comp
(map :data)
(mapcat bfc/collect-used-media)))
(mapcat cfh/collect-used-media)))
(defn- clean-file-media!
"Performs the garbage collection of file media objects."