Reorganize fdata/pointer-map feature helpers

Mainly move all pointer-map related helpers from app.rpc.commands.files
to the the app.features.fdata namespace and normalizes codestile around
feature handling on all affected code.

This commit also comes with several features related bugifxes on the
components-v2 migration code:

- properly migrate legacy feature names on apply components-v2 migration
- start using new fdata feature related functions
- prevent generation of a ephimeral pointer on each graphic migration
  operation; on large files this caused a very noticiable overhead of
  creating a big number of completly unused pointer maps
- do persistence after validation and not before
This commit is contained in:
Andrey Antukh 2023-12-07 11:51:52 +01:00 committed by Andrés Moya
parent 5669bfc260
commit 417366d998
13 changed files with 649 additions and 610 deletions

View file

@ -249,6 +249,12 @@
:code :unable-resolve-connection
:hint "expected conn or system map"))))
(defn connection-map?
"Check if the provided value is a map like data structure that
contains a database connection."
[o]
(and (map? o) (connection? (::conn o))))
(defn- get-connectable
[o]
(cond

View file

@ -14,7 +14,7 @@
[app.common.files.changes-builder :as fcb]
[app.common.files.helpers :as cfh]
[app.common.files.libraries-helpers :as cflh]
[app.common.files.migrations :as pmg]
[app.common.files.migrations :as fmg]
[app.common.files.shapes-helpers :as cfsh]
[app.common.files.validate :as cfv]
[app.common.geom.point :as gpt]
@ -32,6 +32,7 @@
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.db :as db]
[app.features.fdata :as fdata]
[app.http.sse :as sse]
[app.media :as media]
[app.rpc.commands.files :as files]
@ -40,7 +41,6 @@
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[buddy.core.codecs :as bc]
@ -703,7 +703,6 @@
(try
(->> (d/zip media-group grid)
(map (fn [[mobj position]]
(l/trc :hint "submit graphic processing" :file-id (str (:id fdata)) :id (str (:id mobj)))
(sse/tap {:type :migration-progress
:section :graphics
:name (:name mobj)})
@ -761,7 +760,7 @@
(create-media-grid fdata page-id (:id frame) grid assets)
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap))))))))))
(defn- migrate-file-data
(defn- migrate-fdata
[fdata libs]
(let [migrated? (dm/get-in fdata [:options :components-v2])]
(if migrated?
@ -770,42 +769,38 @@
fdata (migrate-graphics fdata)]
(update fdata :options assoc :components-v2 true)))))
(defn- process-file
[{:keys [id] :as file} & {:keys [validate? throw-on-validate?]}]
(let [conn (::db/conn *system*)]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
cfeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objectd-map") omap/wrap identity)]
(defn- process-fdata
[fdata id]
(-> fdata
(assoc :id id)
(fdata/process-pointers deref)
(fmg/migrate-data)))
(let [file (-> file
(update :data blob/decode)
(update :data assoc :id id)
(pmg/migrate-file))
(defn- process-file
[{:keys [::db/conn] :as system} id & {:keys [validate? throw-on-validate?]}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial fdata/load-pointer *system* id)]
(let [file (binding [cfeat/*new* (atom #{})]
(-> (files/get-file system id :migrate? false)
(update :data process-fdata id)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features)))
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(pmg/migrate-file))))))
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(update :data process-fdata id))))))
(d/index-by :id))
pmap? (contains? (:features file) "fdata/pointer-map")
file (-> file
(update :data migrate-file-data libs)
(update :features conj "components/v2"))]
(when (contains? (:features file) "fdata/pointer-map")
(files/persist-pointers! conn id))
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)})
(update :data migrate-fdata libs)
(update :features conj "components/v2")
(cond-> pmap? (fdata/enable-pointer-map)))
]
(when validate?
(if throw-on-validate?
@ -816,7 +811,16 @@
:file-name (:name file)
:error error))))
(dissoc file :data)))))
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)})
(when pmap?
(fdata/persist-pointers! system id))
(dissoc file :data))))
(defn migrate-file!
[system file-id & {:keys [validate? throw-on-validate?]}]
@ -830,13 +834,12 @@
(let [system (update system ::sto/storage media/configure-assets-storage)]
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(fn [system]
(binding [*system* system]
(fsnap/take-file-snapshot! system {:file-id file-id :label "migration/components-v2"})
(-> (db/get conn :file {:id file-id})
(update :features db/decode-pgarray #{})
(process-file :validate? validate?
:throw-on-validate? throw-on-validate?))))))
(process-file system file-id
:validate? validate?
:throw-on-validate? throw-on-validate?)))))
(finally
(let [elapsed (tpoint)

View file

@ -7,42 +7,90 @@
(ns app.features.fdata
"A `fdata/*` related feature migration helpers"
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.db :as db]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OBJECTS-MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn enable-objects-map
[file]
(let [update-fn #(d/update-when % :objects omap/wrap)]
(-> file
(update :data (fn [data]
(-> data
(update :pages-index update-vals #(update % :objects omap/wrap))
(update :components update-vals #(update % :objects omap/wrap)))))
(update :features conj "fdata/objects-map")))
(update :data (fn [fdata]
(-> fdata
(update :pages-index update-vals update-fn)
(update :components update-vals update-fn))))
(update :features conj "fdata/objects-map"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; POINTER-MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn load-pointer
"A database loader pointer helper"
[system file-id id]
(let [{:keys [content]} (db/get system :file-data-fragment
{:id id :file-id file-id}
{::db/columns [:content]
::db/check-deleted? false})]
(when-not content
(ex/raise :type :internal
:code :fragment-not-found
:hint "fragment not found"
:file-id file-id
:fragment-id id))
(blob/decode content)))
(defn persist-pointers!
"Given a database connection and the final file-id, persist all
pointers to the underlying storage (the database)."
[system file-id]
(doseq [[id item] @pmap/*tracked*]
(when (pmap/modified? item)
(l/trc :hint "persist pointer" :file-id (str file-id) :id (str id))
(let [content (-> item deref blob/encode)]
(db/insert! system :file-data-fragment
{:id id
:file-id file-id
:content content})))))
(defn process-pointers
"Apply a function to all pointers on the file. Usuly used for
dereference the pointer to a plain value before some processing."
[fdata update-fn]
(cond-> fdata
(contains? fdata :pages-index)
(update :pages-index process-pointers update-fn)
:always
(update-vals (fn [val]
(if (pmap/pointer-map? val)
(update-fn val)
val)))))
(defn get-used-pointer-ids
"Given a file, return all pointer ids used in the data."
[fdata]
(->> (concat (vals fdata)
(vals (:pages-index fdata)))
(into #{} (comp (filter pmap/pointer-map?)
(map pmap/get-id)))))
(defn enable-pointer-map
"Enable the fdata/pointer-map feature on the file."
[file]
(-> file
(update :data (fn [data]
(-> data
(update :data (fn [fdata]
(-> fdata
(update :pages-index update-vals pmap/wrap)
(update :components pmap/wrap))))
(update :features conj "fdata/pointer-map")))
;; (defn enable-shape-data-type
;; [file]
;; (letfn [(update-object [object]
;; (-> object
;; (d/update-when :selrect grc/make-rect)
;; (d/update-when :svg-viewbox grc/make-rect)
;; (cts/map->Shape)))
;; (update-container [container]
;; (d/update-when container :objects update-vals update-object))]
;; (-> file
;; (update :data (fn [data]
;; (-> data
;; (update :pages-index update-vals update-container)
;; (update :components update-vals update-container))))
;; (update :features conj "fdata/shape-data-type"))))

View file

@ -21,8 +21,8 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.components-v2 :as features.components-v2]
[app.features.fdata :as features.fdata]
[app.features.components-v2 :as feat.compv2]
[app.features.fdata :as feat.fdata]
[app.http.sse :as sse]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
@ -305,25 +305,21 @@
(defn- get-files
[cfg ids]
(letfn [(get-files* [{:keys [::db/conn]}]
(db/run! cfg (fn [{:keys [::db/conn]}]
(let [sql (str "SELECT id FROM file "
" WHERE id = ANY(?) ")
ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql ids])
(into [] (map :id))
(not-empty))))]
(db/run! cfg get-files*)))
(not-empty))))))
(defn- get-file
[cfg file-id]
(letfn [(get-file* [{:keys [::db/conn]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
(db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(some-> (db/get* conn :file {:id file-id} {::db/remove-deleted? false})
(files/decode-row)
(files/process-pointers deref))))]
(db/run! cfg get-file*)))
(update :data feat.fdata/process-pointers deref))))))
(defn- get-file-media
[{:keys [::db/pool]} {:keys [data id] :as file}]
@ -666,7 +662,7 @@
(doseq [[feature file-id] (-> *state* deref :pending-to-migrate)]
(case feature
"components/v2"
(features.components-v2/migrate-file! options file-id
(feat.compv2/migrate-file! options file-id
:validate? validate?
:throw-on-validate? true)
@ -702,11 +698,11 @@
(cond-> file
(and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(features.fdata/enable-objects-map)
(feat.fdata/enable-objects-map)
(and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(features.fdata/enable-pointer-map)))
(feat.fdata/enable-pointer-map)))
(defn- get-remaped-thumbnails
[thumbnails file-id]
@ -717,7 +713,7 @@
thumbnails))
(defmethod read-section :v1/files
[{:keys [::db/conn ::input ::project-id ::enabled-features ::timestamp ::overwrite?]}]
[{:keys [::db/conn ::input ::project-id ::enabled-features ::timestamp ::overwrite?] :as system}]
(doseq [expected-file-id (-> *state* deref :files)]
(let [file (read-obj! input)
@ -773,7 +769,6 @@
cfeat/*previous* (:features file)
pmap/*tracked* (atom {})]
(let [params (-> file
(assoc :id file-id')
(assoc :features features)
@ -821,7 +816,7 @@
(create-or-update-file! conn params)
(db/insert! conn :file params))
(files/persist-pointers! conn file-id')
(feat.fdata/persist-pointers! system file-id')
(when overwrite?
(db/delete! conn :file-thumbnail {:file-id file-id'}))

View file

@ -12,6 +12,7 @@
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
@ -43,15 +44,17 @@
(defn- get-file
"A specialized version of get-file for comments module."
[conn file-id page-id]
(binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
(if-let [{:keys [data] :as file} (some-> (db/exec-one! conn [sql:get-file file-id]) (files/decode-row))]
[{:keys [::db/conn] :as cfg} file-id page-id]
(if-let [{:keys [data] :as file} (some-> (db/exec-one! conn [sql:get-file file-id])
(files/decode-row))]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(-> file
(assoc :page-name (dm/get-in data [:pages-index page-id :name]))
(assoc :page-id page-id))
(assoc :page-id page-id)))
(ex/raise :type :not-found
:code :object-not-found
:hint "file not found"))))
:hint "file not found")))
(defn- get-comment-thread
[conn thread-id & {:as opts}]
@ -288,12 +291,11 @@
(sv/defmethod ::create-comment-thread
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [::db/pool] :as cfg}
{:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
(db/with-atomic [conn pool]
(let [{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
[cfg {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(let [{:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)]
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/comment-threads-per-file
@ -319,7 +321,7 @@
:page-name page-name
:position position
:content content
:frame-id frame-id})))))
:frame-id frame-id}))))))
(defn- create-comment-thread
@ -402,8 +404,7 @@
;; --- COMMAND: Add Comment
(declare get-comment-thread)
(declare create-comment)
(declare ^:private get-comment-thread)
(s/def ::create-comment
(s/keys :req [::rpc/profile-id]
@ -413,10 +414,11 @@
(sv/defmethod ::create-comment
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
(db/with-atomic [conn pool]
[cfg {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content]}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)
{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
{:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)]
(files/check-comment-permissions! conn profile-id (:id file) share-id)
(quotes/check-quote! conn
@ -455,7 +457,8 @@
;; current thread.
(upsert-comment-thread-status! conn profile-id thread-id request-at)
(vary-meta comment assoc ::audit/props props)))))
(vary-meta comment assoc ::audit/props props))))))
;; --- COMMAND: Update Comment
@ -466,8 +469,10 @@
(sv/defmethod ::update-comment
{::doc/added "1.15"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
(db/with-atomic [conn pool]
[cfg {:keys [::rpc/profile-id ::rpc/request-at id share-id content]}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [{:keys [thread-id owner-id] :as comment} (get-comment conn id ::db/for-update? true)
{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)]
@ -478,7 +483,7 @@
(ex/raise :type :validation
:code :not-allowed))
(let [{:keys [page-name] :as file} (get-file conn file-id page-id)]
(let [{:keys [page-name] :as file} (get-file cfg file-id page-id)]
(db/update! conn :comment
{:content content
:modified-at request-at}
@ -488,7 +493,7 @@
{:modified-at request-at
:page-name page-name}
{:id thread-id})
nil))))
nil)))))
;; --- COMMAND: Delete Comment Thread
@ -499,7 +504,7 @@
(sv/defmethod ::delete-comment-thread
{::doc/added "1.15"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id]}]
(db/with-atomic [conn pool]
(let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
@ -539,12 +544,12 @@
(sv/defmethod ::update-comment-thread-position
{::doc/added "1.15"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id position frame-id share-id]}]
(db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread
{:modified-at (::rpc/request-at params)
{:modified-at request-at
:position (db/pgpoint position)
:frame-id frame-id}
{:id (:id thread)})
@ -559,12 +564,12 @@
(sv/defmethod ::update-comment-thread-frame
{::doc/added "1.15"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id frame-id share-id]}]
(db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread
{:modified-at (::rpc/request-at params)
{:modified-at request-at
:frame-id frame-id}
{:id id})
nil)))

View file

@ -20,6 +20,7 @@
[app.common.types.file :as ctf]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
@ -181,62 +182,6 @@
:code :object-not-found
:hint "not found"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FEATURES: pointer-map
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn load-pointer
[conn file-id id]
(dm/assert!
"expected valid connection"
(db/connection? conn))
(let [{:keys [content]} (db/get conn :file-data-fragment
{:id id :file-id file-id}
{::db/columns [:content]
::db/check-deleted? false})]
(when-not content
(ex/raise :type :internal
:code :fragment-not-found
:hint "fragment not found"
:file-id file-id
:fragment-id id))
(blob/decode content)))
(defn persist-pointers!
[conn file-id]
(doseq [[id item] @pmap/*tracked*]
(when (pmap/modified? item)
(let [content (-> item deref blob/encode)]
(db/insert! conn :file-data-fragment
{:id id
:file-id file-id
:content content})))))
(defn process-pointers
[file update-fn]
(update file :data (fn resolve-fn [data]
(cond-> data
(contains? data :pages-index)
(update :pages-index resolve-fn)
:always
(update-vals (fn [val]
(if (pmap/pointer-map? val)
(update-fn val)
val)))))))
(defn get-all-pointer-ids
"Given a file, return all pointer ids used in the data."
[fdata]
(->> (concat (vals fdata)
(vals (:pages-index fdata)))
(into #{} (comp (filter pmap/pointer-map?)
(map pmap/get-id)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUERY COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -277,32 +222,12 @@
[:id ::sm/uuid]
[:project-id {:optional true} ::sm/uuid]]))
(defn get-file
[conn id & {:keys [project-id migrate?
include-deleted?
lock-for-update?]
:or {include-deleted? false
lock-for-update? false}}]
(dm/assert!
"expected raw connection"
(db/connection? conn))
(binding [pmap/*load-fn* (partial load-pointer conn id)
(defn- migrate-file
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)
cfeat/*new* (atom #{})]
(let [params (merge {:id id}
(when (some? project-id)
{:project-id project-id}))
file (-> (db/get conn :file params
{::db/check-deleted? (not include-deleted?)
::db/remove-deleted? (not include-deleted?)
::db/for-update? lock-for-update?})
(decode-row)
(cond-> migrate?
(fmg/migrate-file)))]
(let [file (fmg/migrate-file file)]
;; NOTE: when file is migrated, we break the rule of no perform
;; mutations on get operations and update the file with all
;; migrations applied
@ -317,10 +242,32 @@
{:data (blob/encode (:data file))
:features (db/create-array conn "text" features)}
{:id id})
(persist-pointers! conn id)
(feat.fdata/persist-pointers! cfg id)
(assoc file :features features))
file))))
(defn get-file
[{:keys [::db/conn] :as cfg} id & {:keys [project-id migrate?
include-deleted?
lock-for-update?]
:or {include-deleted? false
lock-for-update? false}}]
(dm/assert!
"expected cfg with valid connection"
(db/connection-map? cfg))
(let [params (merge {:id id}
(when (some? project-id)
{:project-id project-id}))
file (-> (db/get conn :file params
{::db/check-deleted? (not include-deleted?)
::db/remove-deleted? (not include-deleted?)
::db/for-update? lock-for-update?})
(decode-row))]
(if migrate?
(migrate-file cfg file)
file)))
(defn get-minimal-file
[{:keys [::db/pool] :as cfg} id]
(db/get pool :file {:id id} {:columns [:id :modified-at :revn]}))
@ -345,7 +292,7 @@
:project-id project-id
:file-id id)
file (-> (get-file conn id :project-id project-id)
file (-> (get-file cfg id :project-id project-id)
(assoc :permissions perms)
(check-version!))
@ -358,8 +305,8 @@
;; pointers on backend and return a complete file.
file (if (and (contains? (:features file) "fdata/pointer-map")
(not (contains? (:features params) "fdata/pointer-map")))
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(process-pointers file deref))
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(update file :data feat.fdata/process-pointers deref))
file)]
(vary-meta file assoc ::cond/key (get-file-etag params file)))))))
@ -498,6 +445,7 @@
(defn get-page
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id] :as params}]
(when (and (uuid? object-id)
(not (uuid? page-id)))
(ex/raise :type :validation
@ -508,13 +456,13 @@
:profile-id profile-id
:file-id file-id)
file (get-file conn file-id)
file (get-file cfg file-id)
_ (-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
page (binding [pmap/*load-fn* (partial load-pointer conn file-id)]
page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(let [page-id (or page-id (-> file :data :pages first))
page (dm/get-in file [:data :pages-index page-id])]
(if (pmap/pointer-map? page)
@ -573,17 +521,16 @@
and p.team_id = ?
order by f.modified_at desc")
;; FIXME: i'm not sure about feature handling here... ???
(defn get-team-shared-files
[conn team-id]
(defn- get-library-summary
[cfg {:keys [id data] :as file}]
(letfn [(assets-sample [assets limit]
(let [sorted-assets (->> (vals assets)
(sort-by #(str/lower (:name %))))]
{:count (count sorted-assets)
:sample (into [] (take limit sorted-assets))}))
:sample (into [] (take limit sorted-assets))}))]
(library-summary [{:keys [id data] :as file}]
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(let [load-objects (fn [component]
(ctf/load-component-objects data component))
components-sample (-> (assets-sample (ctkl/components data) 4)
@ -591,8 +538,11 @@
{:components components-sample
:media (assets-sample (:media data) 3)
:colors (assets-sample (:colors data) 3)
:typographies (assets-sample (:typographies data) 3)})))]
:typographies (assets-sample (:typographies data) 3)}))))
(defn- get-team-shared-files
[{:keys [::db/conn] :as cfg} {:keys [team-id profile-id]}]
(teams/check-read-permissions! conn profile-id team-id)
(->> (db/exec! conn [sql:team-shared-files team-id])
(into #{} (comp
(map decode-row)
@ -602,8 +552,8 @@
(dissoc :media-id)
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(dissoc row :media-id))))
(map #(assoc % :library-summary (library-summary %)))
(map #(dissoc % :data)))))))
(map #(assoc % :library-summary (get-library-summary cfg %)))
(map #(dissoc % :data))))))
(def ^:private schema:get-team-shared-files
[:map {:title "get-team-shared-files"}
@ -613,10 +563,8 @@
"Get all file (libraries) for the specified team."
{::doc/added "1.17"
::sm/params schema:get-team-shared-files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(get-team-shared-files conn team-id)))
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg get-team-shared-files (assoc params :profile-id profile-id)))
;; --- COMMAND QUERY: get-file-libraries
@ -744,20 +692,15 @@
;; --- COMMAND QUERY: get-file-summary
(sv/defmethod ::get-file-summary
"Retrieve a file summary by its ID. Only authenticated users."
{::doc/added "1.20"
::sm/params schema:get-file}
[cfg {:keys [::rpc/profile-id id project-id] :as params}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(defn- get-file-summary
[{:keys [::db/conn] :as cfg} {:keys [profile-id id project-id] :as params}]
(check-read-permissions! conn profile-id id)
(let [team (teams/get-team conn
:profile-id profile-id
:project-id project-id
:file-id id)
file (get-file conn id :project-id project-id)]
file (get-file cfg id :project-id project-id)]
(-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
@ -767,7 +710,14 @@
:components-count (count (ctkl/components-seq (:data file)))
:graphics-count (count (get-in file [:data :media] []))
:colors-count (count (get-in file [:data :colors] []))
:typography-count (count (get-in file [:data :typographies] []))}))))
:typography-count (count (get-in file [:data :typographies] []))}))
(sv/defmethod ::get-file-summary
"Retrieve a file summary by its ID. Only authenticated users."
{::doc/added "1.20"
::sm/params schema:get-file}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg get-file-summary (assoc params :profile-id profile-id)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS
@ -827,10 +777,15 @@
ORDER BY f.created_at ASC;")
(defn- absorb-library-by-file!
[conn ldata file-id]
(binding [pmap/*load-fn* (partial load-pointer conn file-id)
[cfg ldata file-id]
(dm/assert!
"expected cfg with valid connection"
(db/connection-map? cfg))
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)
pmap/*tracked* (pmap/create-tracked)]
(let [file (-> (get-file conn file-id
(let [file (-> (get-file cfg file-id
:include-deleted? true
:lock-for-update? true)
(update :data ctf/absorb-assets ldata))]
@ -839,42 +794,36 @@
:library-id (str (:id ldata))
:file-id (str file-id))
(db/update! conn :file
(db/update! cfg :file
{:revn (inc (:revn file))
:data (blob/encode (:data file))
:modified-at (dt/now)}
{:id file-id})
(persist-pointers! conn file-id))))
(feat.fdata/persist-pointers! cfg file-id))))
(defn- absorb-library!
"Find all files using a shared library, and absorb all library assets
into the file local libraries"
[conn {:keys [id] :as library}]
(let [ldata (binding [pmap/*load-fn* (partial load-pointer conn id)]
(-> library (process-pointers deref) :data))
ids (->> (db/exec! conn [sql:get-referenced-files id])
[cfg {:keys [id] :as library}]
(dm/assert!
"expected cfg with valid connection"
(db/connection-map? cfg))
(let [ldata (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(-> library :data (feat.fdata/process-pointers deref)))
ids (->> (db/exec! cfg [sql:get-referenced-files id])
(map :id))]
(l/trc :hint "absorbing library"
:library-id (str id)
:files (str/join "," (map str ids)))
(run! (partial absorb-library-by-file! conn ldata) ids)))
(run! (partial absorb-library-by-file! cfg ldata) ids)))
(def ^:private
schema:set-file-shared
(sm/define
[:map {:title "set-file-shared"}
[:id ::sm/uuid]
[:is-shared :boolean]]))
(sv/defmethod ::set-file-shared
{::doc/added "1.17"
::webhooks/event? true
::sm/params schema:set-file-shared}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(defn- set-file-shared
[{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
(check-edition-permissions! conn profile-id id)
(let [file (db/get-by-id conn id {:columns [:id :name :is-shared]})
file (cond
@ -884,7 +833,7 @@
;; file, we need to perform more complex operation,
;; so in this case we retrieve the complete file and
;; perform all required validations.
(let [file (-> (get-file conn id :lock-for-update? true)
(let [file (-> (get-file cfg id :lock-for-update? true)
(check-version!)
(assoc :is-shared false))
team (teams/get-team conn
@ -895,7 +844,7 @@
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file)))
(absorb-library! conn file)
(absorb-library! cfg file)
(db/delete! conn :file-library-rel {:library-file-id id})
(db/update! conn :file
@ -922,7 +871,21 @@
(select-keys file [:id :name :is-shared])
{::audit/props {:name (:name file)
:project-id (:project-id file)
:is-shared (:is-shared file)}}))))
:is-shared (:is-shared file)}})))
(def ^:private
schema:set-file-shared
(sm/define
[:map {:title "set-file-shared"}
[:id ::sm/uuid]
[:is-shared :boolean]]))
(sv/defmethod ::set-file-shared
{::doc/added "1.17"
::webhooks/event? true
::sm/params schema:set-file-shared}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg set-file-shared (assoc params :profile-id profile-id)))
;; --- MUTATION COMMAND: delete-file
@ -939,12 +902,8 @@
[:map {:title "delete-file"}
[:id ::sm/uuid]]))
(sv/defmethod ::delete-file
{::doc/added "1.17"
::webhooks/event? true
::sm/params schema:delete-file}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(defn- delete-file
[{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
(check-edition-permissions! conn profile-id id)
(let [file (mark-file-deleted! conn id)]
@ -952,7 +911,7 @@
;; the whole file, proceed with feature checking and properly execute
;; the absorb-library procedure
(when (:is-shared file)
(let [file (-> (get-file conn id
(let [file (-> (get-file cfg id
:lock-for-update? true
:include-deleted? true)
(check-version!))
@ -967,13 +926,20 @@
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file)))
(absorb-library! conn file)))
(absorb-library! cfg file)))
(rph/with-meta (rph/wrap)
{::audit/props {:project-id (:project-id file)
:name (:name file)
:created-at (:created-at file)
:modified-at (:modified-at file)}}))))
:modified-at (:modified-at file)}})))
(sv/defmethod ::delete-file
{::doc/added "1.17"
::webhooks/event? true
::sm/params schema:delete-file}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg delete-file (assoc params :profile-id profile-id)))
;; --- MUTATION COMMAND: link-file-to-library

View file

@ -7,12 +7,14 @@
(ns app.rpc.commands.files-create
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.schema :as sm]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
@ -44,13 +46,20 @@
:or {is-shared false revn 0 create-page true}
:as params}]
(dm/assert!
"expected a valid connection"
(db/connection? conn))
(let [id (or id (uuid/next))
pointers (atom {})
pointers (pmap/create-tracked)
pmap? (contains? features "fdata/pointer-map")
omap? (contains? features "fdata/objects-map")
data (binding [pmap/*tracked* pointers
cfeat/*current* features
cfeat/*wrap-with-objects-map-fn* (if (features "fdata/objects-map") omap/wrap identity)
cfeat/*wrap-with-pointer-map-fn* (if (features "fdata/pointer-map") pmap/wrap identity)]
cfeat/*wrap-with-objects-map-fn* (if omap? omap/wrap identity)
cfeat/*wrap-with-pointer-map-fn* (if pmap? pmap/wrap identity)]
(if create-page
(ctf/make-file-data id)
(ctf/make-file-data id nil)))
@ -72,7 +81,7 @@
:deleted-at deleted-at}))]
(binding [pmap/*tracked* pointers]
(files/persist-pointers! conn id))
(feat.fdata/persist-pointers! cfg id))
(->> (assoc params :file-id id :role :owner)
(create-file-role! conn))

View file

@ -16,6 +16,7 @@
[app.common.types.shape-tree :as ctt]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.media :as media]
@ -100,28 +101,28 @@
;; loading all pages into memory for find the frame set for thumbnail.
(defn get-file-data-for-thumbnail
[conn {:keys [data id] :as file}]
[{:keys [::db/conn] :as cfg} {:keys [data id] :as file}]
(letfn [;; function responsible on finding the frame marked to be
;; used as thumbnail; the returned frame always have
;; the :page-id set to the page that it belongs.
(get-thumbnail-frame [data]
(get-thumbnail-frame [file]
;; NOTE: this is a hack for avoid perform blocking
;; operation inside the for loop, clojure lazy-seq uses
;; synchronized blocks that does not plays well with
;; virtual threads, so we need to perform the load
;; operation first. This operation forces all pointer maps
;; load into the memory.
(->> (-> data :pages-index vals)
(filter pmap/pointer-map?)
(run! pmap/load!))
;; virtual threads where all rpc methods calls are
;; dispatched, so we need to perform the load operation
;; first. This operation forces all pointer maps load into
;; the memory.
;;
;; FIXME: this is no longer true with clojure>=1.12
(let [{:keys [data]} (update file :data feat.fdata/process-pointers pmap/load!)]
;; Then proceed to find the frame set for thumbnail
(d/seek #(or (:use-for-thumbnail %)
(:use-for-thumbnail? %)) ; NOTE: backward comp (remove on v1.21)
(for [page (-> data :pages-index vals)
frame (-> page :objects ctt/get-frames)]
(assoc frame :page-id (:id page)))))
(assoc frame :page-id (:id page))))))
;; function responsible to filter objects data structure of
;; all unneeded shapes if a concrete frame is provided. If no
@ -165,8 +166,8 @@
objects)))]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(let [frame (get-thumbnail-frame data)
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(let [frame (get-thumbnail-frame file)
frame-id (:id frame)
page-id (or (:page-id frame)
(-> data :pages first))
@ -220,7 +221,7 @@
:profile-id profile-id
:file-id file-id)
file (files/get-file conn file-id)]
file (files/get-file cfg file-id)]
(-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
@ -228,7 +229,7 @@
{:file-id file-id
:revn (:revn file)
:page (get-file-data-for-thumbnail conn file)}))))
:page (get-file-data-for-thumbnail cfg file)}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS

View file

@ -17,7 +17,7 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :refer [enable-pointer-map enable-objects-map]]
[app.features.fdata :as feat.fdata]
[app.http.errors :as errors]
[app.loggers.audit :as audit]
[app.loggers.webhooks :as webhooks]
@ -106,12 +106,12 @@
(defn- wrap-with-pointer-map-context
[f]
(fn [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
(fn [cfg {:keys [id] :as file}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
cfeat/*wrap-with-pointer-map-fn* pmap/wrap]
(let [result (f cfg file)]
(files/persist-pointers! conn id)
(feat.fdata/persist-pointers! cfg id)
result))))
(defn- wrap-with-objects-map-context
@ -236,7 +236,7 @@
;; to be executed on a separated executor for avoid to do the
;; CPU intensive operation on vthread.
update-fdata-fn (partial update-file-data conn file changes skip-validate)
update-fdata-fn (partial update-file-data cfg file changes skip-validate)
file (-> (climit/configure cfg :update-file/global)
(climit/run! update-fdata-fn executor))]
@ -290,7 +290,7 @@
file)
(defn- update-file-data
[conn file changes skip-validate]
[{:keys [::db/conn] :as cfg} file changes skip-validate]
(let [file (update file :data (fn [data]
(-> data
(blob/decode)
@ -304,10 +304,10 @@
(not skip-validate))
(->> (files/get-file-libraries conn (:id file))
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* nil]
(-> (files/get-file conn id :migrate? false)
(files/process-pointers deref) ; ensure all pointers resolved
(-> (files/get-file cfg id :migrate? false)
(feat.fdata/process-pointers deref) ; ensure all pointers resolved
(fmg/migrate-file))))))
(d/index-by :id)))]
@ -332,11 +332,11 @@
(cond-> (and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(enable-objects-map))
(feat.fdata/enable-objects-map))
(cond-> (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(enable-pointer-map))
(feat.fdata/enable-pointer-map))
(update :data blob/encode))))

View file

@ -14,11 +14,11 @@
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.http.sse :as sse]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.commands.binfile :as binfile]
[app.rpc.commands.files :as files]
[app.rpc.commands.projects :as proj]
[app.rpc.commands.teams :as teams :refer [create-project-role create-project]]
[app.rpc.doc :as-alias doc]
@ -49,9 +49,8 @@
{::doc/added "1.16"
::webhooks/event? true
::sm/params schema:duplicate-file}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(duplicate-file conn (assoc params :profile-id profile-id))))
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg duplicate-file (assoc params :profile-id profile-id)))
(defn- remap-id
[item index key]
@ -60,7 +59,7 @@
(assoc key (get index (get item key) (get item key)))))
(defn- process-file
[conn {:keys [id] :as file} index]
[cfg index {:keys [id] :as file}]
(letfn [(process-form [form]
(cond-> form
;; Relink library items
@ -103,26 +102,28 @@
(dissoc k))
res)))
media
media))]
(-> file
(update :id #(get index %))
(update :data
(fn [data]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)
pmap/*tracked* (atom {})]
(let [file-id (get index id)
data (-> data
media))
(update-fdata [fdata new-id]
(-> fdata
(blob/decode)
(assoc :id file-id)
(assoc :id new-id)
(pmg/migrate-data)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(d/without-nils)
(files/process-pointers pmap/clone)
(blob/encode))]
(files/persist-pointers! conn file-id)
data)))))))
(feat.fdata/process-pointers pmap/clone)
(blob/encode)))]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)]
(let [new-id (get index id)
file (-> file
(assoc :id new-id)
(update :data update-fdata new-id))]
(feat.fdata/persist-pointers! cfg new-id)
file))))
(def sql:get-used-libraries
"select flr.*
@ -139,7 +140,7 @@
and so.deleted_at is null")
(defn duplicate-file*
[conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
(let [flibs (or flibs (db/exec! conn [sql:get-used-libraries (:id file)]))
fmeds (or fmeds (db/exec! conn [sql:get-used-media-objects (:id file)]))
@ -182,7 +183,7 @@
(assoc :modified-at now)
(assoc :ignore-sync-until ignore))
file (process-file conn file index)]
file (process-file cfg index file)]
(db/insert! conn :file file)
(db/insert! conn :file-profile-rel
@ -201,13 +202,15 @@
file))
(defn duplicate-file
[conn {:keys [profile-id file-id] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id] :as params}]
(let [file (db/get-by-id conn :file file-id)
index {file-id (uuid/next)}
params (assoc params :index index :file file)]
(proj/check-edition-permissions! conn profile-id (:project-id file))
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
(-> (duplicate-file* conn params {:reset-shared-flag true})
;; FIXME: why we decode the data here?
(-> (duplicate-file* cfg params {:reset-shared-flag true})
(update :data blob/decode)
(update :features db/decode-pgarray #{}))))
@ -227,12 +230,11 @@
{::doc/added "1.16"
::webhooks/event? true
::sm/params schema:duplicate-project}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(duplicate-project conn (assoc params :profile-id (::rpc/profile-id params)))))
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg duplicate-project (assoc params :profile-id profile-id)))
(defn duplicate-project
[conn {:keys [profile-id project-id name] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id project-id name] :as params}]
;; Defer all constraints
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
@ -270,7 +272,7 @@
(let [file (db/get-by-id conn :file id)
params (assoc params :file file)
opts {:reset-shared-flag false}]
(duplicate-file* conn params opts))))
(duplicate-file* cfg params opts))))
;; return the created project
project))

View file

@ -29,7 +29,7 @@
(defn- get-view-only-bundle
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id ::perms] :as params}]
(let [file (files/get-file conn file-id)
(let [file (files/get-file cfg file-id)
project (db/get conn :project
{:id (:project-id file)}

View file

@ -23,6 +23,7 @@
[app.config :as cfg]
[app.db :as db]
[app.db.sql :as sql]
[app.features.fdata :as feat.fdata]
[app.main :refer [system]]
[app.rpc.commands.files :as files]
[app.rpc.commands.files-update :as files-update]
@ -39,7 +40,6 @@
[promesa.exec :as px]
[promesa.exec.csp :as sp]))
(def ^:dynamic *conn* nil)
(def ^:dynamic *system* nil)
(defn println!
@ -63,71 +63,75 @@
(defn get-file
"Get the migrated data of one file."
[system id]
[system id & {:keys [migrate?] :or {migrate? true}}]
(db/run! system
(fn [{:keys [::db/conn]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (files/get-file conn id)
(files/process-pointers deref))))))
(fn [system]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? migrate?)
(update :data feat.fdata/process-pointers deref))))))
(defn validate
"Validate structure, referencial integrity and semantic coherence of
all contents of a file. Returns a list of errors."
[system id]
(db/with-atomic [conn (:app.db/pool system)]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(let [file (files/get-file conn id)
libraries (->> (files/get-file-libraries conn id)
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(let [id (if (string? id) (parse-uuid id) id)
file (files/get-file system id)
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(feat.fdata/process-pointers deref)
(pmg/migrate-file))))))
(d/index-by :id))]
(validate/validate-file file libraries)))))
(validate/validate-file file libs))))))
(defn repair
(defn repair!
"Repair the list of errors detected by validation."
[system id]
(db/with-atomic [conn (:app.db/pool system)]
(let [file (files/get-file conn id)]
(binding [*conn* conn
pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)]
(let [libraries (->> (files/get-file-libraries conn id)
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(let [id (if (string? id) (parse-uuid id) id)
file (files/get-file system id)
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(feat.fdata/process-pointers deref)
(pmg/migrate-file))))))
(d/index-by :id))
errors (validate/validate-file file libraries)
changes (-> (repair/repair-file (:data file) libraries errors)
(get :redo-changes))
errors (validate/validate-file file libs)
changes (-> (repair/repair-file (:data file) libs errors) :redo-changes)
file (-> file
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data blob/encode))]
(files/persist-pointers! conn id)
(when (contains? (:features file) "fdata/pointer-map")
(feat.fdata/persist-pointers! system id))
(db/update! conn :file
{:revn (:revn file)
:data (:data file)
:data-backend nil
:modified-at (dt/now)
:has-media-trimmed false}
{:id (:id file)}))))))
{:id (:id file)})
:repaired)))))
(defn update-file!
"Apply a function to the data of one file. Optionally save the changes or not.
The function receives the decoded and migrated file data."
[system & {:keys [update-fn id rollback? migrate? inc-revn?]
:or {rollback? true migrate? true inc-revn? true}}]
(letfn [(process-file [conn {:keys [features] :as file}]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
(letfn [(process-file [{:keys [::db/conn] :as system} {:keys [features] :as file}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial feat.fdata/load-pointer system id)
cfeat/*wrap-with-pointer-map-fn*
(if (contains? features "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
@ -145,19 +149,19 @@
{:id id}))
(when (contains? (:features file) "fdata/pointer-map")
(files/persist-pointers! conn id))
(feat.fdata/persist-pointers! system id))
(dissoc file :data)))]
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(binding [*conn* conn *system* system]
(fn [system]
(binding [*system* system]
(try
(->> (files/get-file conn id :migrate? migrate?)
(process-file conn))
(->> (files/get-file system id :migrate? migrate?)
(process-file system))
(finally
(when rollback?
(db/rollback! conn)))))))))
(db/rollback! system)))))))))
(defn analyze-files
"Apply a function to all files in the database, reading them in
@ -187,17 +191,17 @@
(println "unexpected exception happened on processing file: " (:id file))
(strace/print-stack-trace cause))
(process-file [conn file-id]
(let [file (binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
(-> (files/get-file conn file-id)
(files/process-pointers deref)))
(process-file [{:keys [::db/conn] :as system} file-id]
(let [file (binding [pmap/*load-fn* (partial feat.fdata/load-pointer system file-id)]
(-> (files/get-file system file-id)
(update :data feat.fdata/process-pointers deref)))
libs (when with-libraries?
(->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (files/get-file conn id)
(files/process-pointers deref))))))
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(-> (files/get-file system id)
(update :data feat.fdata/process-pointers deref))))))
(d/index-by :id)))]
(try
(if with-libraries?
@ -209,19 +213,19 @@
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(try
(binding [*conn* conn *system* system]
(binding [*system* system]
(when (fn? on-init) (on-init))
(run! (partial process-file conn) (get-candidates conn)))
(run! (partial process-file system) (get-candidates conn)))
(finally
(when (fn? on-end)
(ex/ignoring (on-end)))
(db/rollback! conn)))))))
(db/rollback! system)))))))
(defn process-files!
"Apply a function to all files in the database, reading them in
batches."
[{:keys [::db/pool] :as system} & {:keys [chunk-size
[system & {:keys [chunk-size
max-items
workers
start-at
@ -252,11 +256,11 @@
(println! "unexpected exception happened on processing file: " (:id file))
(strace/print-stack-trace cause))
(process-file [conn file-id]
(process-file [system file-id]
(try
(let [{:keys [features] :as file} (files/get-file conn file-id)]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn file-id)
(let [{:keys [features] :as file} (files/get-file system file-id)]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial feat.fdata/load-pointer system file-id)
cfeat/*wrap-with-pointer-map-fn*
(if (contains? features "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
@ -265,30 +269,30 @@
(on-file file)
(when (contains? features "fdata/pointer-map")
(files/persist-pointers! conn file-id))))
(feat.fdata/persist-pointers! system file-id))))
(catch Throwable cause
((or on-error on-error*) cause file-id))))
(run-worker [in index]
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(binding [*conn* conn *system* system]
(fn [system]
(binding [*system* system]
(loop [i 0]
(when-let [file-id (sp/take! in)]
(println! "=> worker: index:" index "| loop:" i "| file:" (str file-id) "|" (px/get-name))
(process-file conn file-id)
(process-file system file-id)
(recur (inc i)))))
(when rollback?
(db/rollback! conn)))))
(db/rollback! system)))))
(run-producer [input]
(db/with-atomic [conn pool]
(db/tx-run! system (fn [{:keys [::db/conn]}]
(doseq [file-id (get-candidates conn)]
(println! "=> producer:" file-id "|" (px/get-name))
(sp/put! input file-id))
(sp/close! input)))]
(sp/close! input))))]
(when (fn? on-init) (on-init))

View file

@ -19,8 +19,8 @@
[app.common.types.shape-tree :as ctt]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.media :as media]
[app.rpc.commands.files :as files]
[app.storage :as sto]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
@ -271,9 +271,9 @@
" limit 1;")
rows (db/exec! conn [sql file-id cursor])]
[(some-> rows peek :created-at)
(mapcat (comp files/get-all-pointer-ids blob/decode :data) rows)]))]
(mapcat (comp feat.fdata/get-used-pointer-ids blob/decode :data) rows)]))]
(let [used (into (files/get-all-pointer-ids data)
(let [used (into (feat.fdata/get-used-pointer-ids data)
(d/iteration get-pointers-chunk
:vf second
:kf first
@ -290,10 +290,10 @@
(defn- process-file
[{:keys [::db/conn] :as cfg} {:keys [id data revn modified-at features] :as file}]
(l/dbg :hint "processing file" :id id :modified-at modified-at)
(l/dbg :hint "processing file" :file-id (str id) :modified-at modified-at)
(binding [pmap/*load-fn* (partial files/load-pointer conn id)
pmap/*tracked* (atom {})]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)]
(let [data (-> (blob/decode data)
(assoc :id id)
(pmg/migrate-data))]
@ -311,4 +311,4 @@
{:has-media-trimmed true}
{:id id})
(files/persist-pointers! conn id))))
(feat.fdata/persist-pointers! cfg id))))