mirror of
https://github.com/penpot/penpot.git
synced 2026-11-04 09:00:37 +00:00
b0e01ef2ef
Depth gate: the compare reads the op log and applies the depth gate before it derives the branch, the same order merge and update from main use, so a log too deep to replay refuses before the derive runs. The refusal names the materialise and the delete, the two remedies the gates do not refuse, in the hint and in the notification copy. Resolutions: the conflict answers of merge-file-branch and update-branch-from-main carry the main revision the conflicts were computed against, and the client sends it as expected-main-revn when resolutions are applied before the dialog's diff fetch returns. Libraries: absorbing skips branch files, so unpublishing or deleting a shared library writes no payload on a branch and the branch keeps its own link; a soft-deleted library resolves nothing there until the branch's next update from main brings main's absorbed copies. The absorbed write passes the file's features to update-file!, which the hand-built params dropped, so the pointer-map fragments the absorption regenerates are persisted and no payload references a fragment no write produced. Queries: the project file count, the team file count, the list of files that use a library, and the socket-REPL team duplication skip branch files. Snapshots: the branch refusal lives in check-restorable!, which the restore command calls before its backup snapshot and the two socket-REPL restore helpers reach through restore!. Migration 0155: the base_branch_revn backfill repositions only the rows whose branch file carries a data payload, so a re-run changes nothing on the branches the op-log model creates. Tests: the branch merge tests run in JavaScript, which the common test runner lists; new backend tests pin the gates, the absorption skip, the query filters, the restore refusals, the migration re-run, and the conflict answers' revision; a new frontend test pins the token the senders carry with resolutions. AI-assisted-by: mixed models Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
1248 lines
43 KiB
Clojure
1248 lines
43 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS SUBSIDIARY SL
|
|
|
|
(ns app.binfile.common
|
|
"A binfile related file processing common code, used for different
|
|
binfile format implementations and management rpc methods."
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.features :as cfeat]
|
|
[app.common.files.changes :as cpc]
|
|
[app.common.files.helpers :as cfh]
|
|
[app.common.files.migrations :as fmg]
|
|
[app.common.files.validate :as fval]
|
|
[app.common.logging :as l]
|
|
[app.common.schema :as sm]
|
|
[app.common.time :as ct]
|
|
[app.common.types.file :as ctf]
|
|
[app.common.uuid :as uuid]
|
|
[app.common.weak :as weak]
|
|
[app.config :as cf]
|
|
[app.db :as db]
|
|
[app.db.sql :as sql]
|
|
[app.features.fdata :as fdata]
|
|
[app.features.file-migrations :as fmigr]
|
|
[app.loggers.audit :as-alias audit]
|
|
[app.loggers.webhooks :as-alias webhooks]
|
|
[app.util.blob :as blob]
|
|
[app.util.pointer-map :as pmap]
|
|
[app.worker :as-alias wrk]
|
|
[clojure.set :as set]
|
|
[cuerdas.core :as str]
|
|
[datoteka.fs :as fs]
|
|
[datoteka.io :as io]))
|
|
|
|
(set! *warn-on-reflection* true)
|
|
|
|
(def ^:dynamic *state* nil)
|
|
(def ^:dynamic *options* nil)
|
|
(def ^:dynamic *reference-file* nil)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; DEFAULTS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Threshold in MiB when we pass from using
|
|
;; in-memory byte-array's to use temporal files.
|
|
(def temp-file-threshold
|
|
(* 1024 1024 2))
|
|
|
|
;; Maximum size allowed for a single binary entry during binfile
|
|
;; import: 100MiB. Covers the storage blobs (`objects/` entries in v3,
|
|
;; streams in v1), whose declared size and hash are verified against the
|
|
;; imported bytes. Legitimate media objects fit comfortably below this;
|
|
;; anything larger is rejected instead of being buffered into memory.
|
|
(def ^:const default-max-binary-entry-size
|
|
(* 1024 1024 100))
|
|
|
|
;; Maximum decompressed size allowed for a single JSON/text zip entry
|
|
;; (manifest, files, pages, shapes, colors, components, typographies,
|
|
;; tokens, plugin-data) during binfile import: 20MiB. Legitimate entries
|
|
;; are KB-sized, so this is deliberately much lower than
|
|
;; default-max-binary-entry-size and bounds the DEFLATE amplification of any
|
|
;; single entry.
|
|
(def ^:const default-max-text-entry-size
|
|
(* 1024 1024 20))
|
|
|
|
;; Maximum total decompressed size allowed for all JSON/text zip entries
|
|
;; combined within a single import job: 200MiB. Bounds the case where many
|
|
;; entries, each individually under default-max-text-entry-size, still sum
|
|
;; to an unreasonable total.
|
|
(def ^:const default-max-text-total-size
|
|
(* 1024 1024 200))
|
|
|
|
;; Maximum number of entries allowed in the import zip: 500,000.
|
|
(def ^:const default-max-zip-entries
|
|
(* 500 1000))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(declare get-resolved-file-libraries)
|
|
(declare update-file!)
|
|
|
|
(def file-attrs
|
|
(sm/keys ctf/schema:file))
|
|
|
|
(defn parse-file-format
|
|
[template]
|
|
(assert (fs/path? template) "expected InputStream for `template`")
|
|
|
|
(with-open [^java.lang.AutoCloseable input (io/input-stream template)]
|
|
(let [buffer (byte-array 4)]
|
|
(io/read-to-buffer input buffer)
|
|
(if (and (= (aget buffer 0) 80)
|
|
(= (aget buffer 1) 75)
|
|
(= (aget buffer 2) 3)
|
|
(= (aget buffer 3) 4))
|
|
:binfile-v3
|
|
:binfile-v1))))
|
|
|
|
(def xf-map-id
|
|
(map :id))
|
|
|
|
(def xf-map-media-id
|
|
(comp
|
|
(mapcat (juxt :media-id
|
|
:thumbnail-id
|
|
:woff1-file-id
|
|
:woff2-file-id
|
|
:ttf-file-id
|
|
:otf-file-id))
|
|
(filter uuid?)))
|
|
|
|
(def into-vec
|
|
(fnil into []))
|
|
|
|
(def conj-vec
|
|
(fnil conj []))
|
|
|
|
(defn initial-state
|
|
[]
|
|
{:storage-objects #{}
|
|
:files #{}
|
|
:teams #{}
|
|
:projects #{}})
|
|
|
|
(defn collect-storage-objects
|
|
[state items]
|
|
(update state :storage-objects into xf-map-media-id items))
|
|
|
|
(defn collect-summary
|
|
[state key items]
|
|
(update state key into xf-map-media-id items))
|
|
|
|
(defn lookup-index
|
|
[id]
|
|
(when id
|
|
(let [val (get-in @*state* [:index id])]
|
|
(l/trc :fn "lookup-index" :id (str id) :result (some-> val str) ::l/sync? true)
|
|
(or val id))))
|
|
|
|
(defn remap-id
|
|
[item key]
|
|
(cond-> item
|
|
(contains? item key)
|
|
(update key lookup-index)))
|
|
|
|
(defn- index-object
|
|
[index obj & attrs]
|
|
(reduce (fn [index attr-fn]
|
|
(let [old-id (attr-fn obj)
|
|
new-id (if (::overwrite *options*) old-id (uuid/next))]
|
|
(assoc index old-id new-id)))
|
|
index
|
|
attrs))
|
|
|
|
(defn update-index
|
|
([coll]
|
|
(update-index {} coll identity))
|
|
([index coll]
|
|
(update-index index coll identity))
|
|
([index coll attr]
|
|
(reduce #(index-object %1 %2 attr) index coll)))
|
|
|
|
(defn- decode-row-features
|
|
[{:keys [features] :as row}]
|
|
(when row
|
|
(cond-> row
|
|
(db/pgarray? features) (assoc :features (db/decode-pgarray features #{})))))
|
|
|
|
(def sql:get-minimal-file
|
|
"SELECT f.id,
|
|
f.revn,
|
|
f.modified_at,
|
|
f.deleted_at
|
|
FROM file AS f
|
|
WHERE f.id = ?")
|
|
|
|
(defn get-minimal-file
|
|
[cfg id & {:as opts}]
|
|
(db/get-with-sql cfg [sql:get-minimal-file id] opts))
|
|
|
|
(def sql:files-with-data
|
|
"SELECT f.id,
|
|
f.project_id,
|
|
f.created_at,
|
|
f.modified_at,
|
|
f.deleted_at,
|
|
f.name,
|
|
f.is_shared,
|
|
f.is_branch,
|
|
f.has_media_trimmed,
|
|
f.revn,
|
|
f.data AS legacy_data,
|
|
f.ignore_sync_until,
|
|
f.comment_thread_seqn,
|
|
f.features,
|
|
f.version,
|
|
f.vern,
|
|
p.team_id,
|
|
coalesce(fd.backend, 'legacy-db') AS backend,
|
|
fd.metadata AS metadata,
|
|
fd.data AS data
|
|
FROM file AS f
|
|
LEFT JOIN file_data AS fd ON (fd.file_id = f.id AND fd.id = f.id)
|
|
INNER JOIN project AS p ON (p.id = f.project_id)")
|
|
|
|
(def sql:get-file
|
|
(str sql:files-with-data " WHERE f.id = ?"))
|
|
|
|
(def sql:get-file-without-data
|
|
(str "WITH files AS (" sql:files-with-data ")"
|
|
"SELECT f.id,
|
|
f.project_id,
|
|
f.created_at,
|
|
f.modified_at,
|
|
f.deleted_at,
|
|
f.name,
|
|
f.is_shared,
|
|
f.has_media_trimmed,
|
|
f.revn,
|
|
f.ignore_sync_until,
|
|
f.comment_thread_seqn,
|
|
f.features,
|
|
f.version,
|
|
f.vern,
|
|
f.team_id
|
|
FROM files AS f
|
|
WHERE f.id = ?"))
|
|
|
|
(defn- migrate-file
|
|
[{:keys [::db/conn] :as cfg} {:keys [read-only?]} {:keys [id] :as file}]
|
|
(binding [pmap/*load-fn* (partial fdata/load-pointer cfg id)
|
|
pmap/*tracked* (pmap/create-tracked)]
|
|
(let [libs (delay (get-resolved-file-libraries cfg file))
|
|
;; For avoid unnecesary overhead of creating multiple
|
|
;; pointers and handly internally with objects map in their
|
|
;; worst case (when probably all shapes and all pointers
|
|
;; will be readed in any case), we just realize/resolve them
|
|
;; before applying the migration to the file.
|
|
file (-> (fdata/realize cfg file)
|
|
(fmg/migrate-file libs))]
|
|
|
|
(if (or read-only? (db/read-only? conn))
|
|
file
|
|
(do ;; When file is migrated, we break the rule of no
|
|
;; perform mutations on get operations and update the
|
|
;; file with all migrations applied
|
|
(update-file! cfg file)
|
|
(fmigr/resolve-applied-migrations cfg file))))))
|
|
|
|
;; --- Branch files: derived data --------------------------------------
|
|
;;
|
|
;; A branch file stores no data of its own: its `:data` is derived by
|
|
;; replaying the branch's op log (`file_branch_change`) over the
|
|
;; merge-base snapshot pinned in `file_branch`. The derive runs inside
|
|
;; `get-file*`, so every read path (workspace bundle, viewer, diff,
|
|
;; merge) sees the same state the editor produced.
|
|
;;
|
|
;; The snapshot query mirrors `fsnap/get-snapshot` (which cannot be
|
|
;; reused here: `app.features.file-snapshots` requires THIS namespace).
|
|
|
|
(def ^:private sql:get-branch-base-snapshot
|
|
"SELECT c.id,
|
|
c.label,
|
|
c.created_at,
|
|
c.updated_at AS modified_at,
|
|
c.deleted_at,
|
|
c.profile_id,
|
|
c.created_by,
|
|
c.locked_by,
|
|
c.revn,
|
|
c.features,
|
|
c.migrations,
|
|
c.version,
|
|
c.file_id,
|
|
c.data AS legacy_data,
|
|
fd.data AS data,
|
|
coalesce(fd.backend, 'legacy-db') AS backend,
|
|
fd.metadata AS metadata
|
|
FROM file_change AS c
|
|
LEFT JOIN file_data AS fd ON (fd.file_id = c.file_id
|
|
AND fd.id = c.id
|
|
AND fd.type = 'snapshot')
|
|
WHERE c.label IS NOT NULL
|
|
AND c.file_id = ?
|
|
AND c.id = ?
|
|
AND CASE WHEN c.created_by = 'user'
|
|
THEN (c.deleted_at IS NULL)
|
|
WHEN c.created_by = 'system'
|
|
THEN (c.deleted_at IS NULL OR c.deleted_at >= ?::timestamptz)
|
|
END")
|
|
|
|
(def ^:private sql:get-branch-changes
|
|
"SELECT changes, data_version
|
|
FROM file_branch_change
|
|
WHERE file_id = ?
|
|
AND deleted_at IS NULL
|
|
ORDER BY revn ASC")
|
|
|
|
(defn get-branch-changes
|
|
"The branch's op log as decoded change batches, oldest first. This is
|
|
the complete delta between the branch and its merge base, which is what
|
|
lets a caller bound work to what the branch touched."
|
|
[{:keys [::db/conn] :as cfg} branch-file-id]
|
|
(->> (db/exec! conn [sql:get-branch-changes branch-file-id])
|
|
(mapv (fn [{:keys [changes]}] (blob/decode changes)))))
|
|
|
|
(defn- migrate-detached
|
|
"Migrate `file` in memory with `migrate-fn`, called as
|
|
`(migrate-fn file libs)`, under the bindings `migrate-file` sets up.
|
|
Persists nothing: the branch derive migrates documents it builds
|
|
itself, the replayed branch and its merge base, and neither has a
|
|
row to write back to."
|
|
[cfg {:keys [id] :as file} migrate-fn]
|
|
(binding [pmap/*load-fn* (partial fdata/load-pointer cfg id)
|
|
pmap/*tracked* (pmap/create-tracked)]
|
|
(migrate-fn file (delay (get-resolved-file-libraries cfg file)))))
|
|
|
|
(defn migrate-branch-base
|
|
"The `:data` of a branch's merge-base snapshot at the current data
|
|
version. The snapshot keeps the version main had when the base was
|
|
taken, while `get-file` migrates main and the branch on every read, so
|
|
a three-way comparison sees one version on all three sides only when
|
|
the base migrates the same way, with main's libraries. A base already
|
|
at the current version comes back as it is.
|
|
|
|
`snapshot` is a snapshot row with its data decoded: `:file-id`,
|
|
`:data`, `:version` and the `:migrations` its data holds."
|
|
[cfg {:keys [file-id data version migrations]}]
|
|
(let [base {:id file-id
|
|
:data data
|
|
:version version
|
|
:migrations (some-> migrations not-empty set)}]
|
|
(if (fmg/need-migration? base)
|
|
(:data (migrate-detached cfg base fmg/migrate-file))
|
|
data)))
|
|
|
|
(defn- branch-file-data
|
|
"Derive the `:data` of a branch file: the merge-base snapshot plus
|
|
every op appended to the branch's log, replayed in revn order.
|
|
|
|
Each op-log row records the data version its changes were written at.
|
|
The replay starts from the base at the base's version, and before a
|
|
row written at a later version it migrates the document to that
|
|
version, the point where an ordinary file migrates across an upgrade.
|
|
The document never migrates past the version of the next row, because
|
|
a migration assumes its input is at the version before it. The file
|
|
returned carries the version and migration set the replay ended at, so
|
|
`get-file*` migrates the rest of the way in memory, and a log with no
|
|
upgrade since the base (the steady state) never migrates at all.
|
|
|
|
Returns the file with `:data` decoded (plain maps); callers that asked
|
|
for `:decode? false` get it re-encoded as bytes so the update-file
|
|
pipeline (which always blob-decodes) is unaffected.
|
|
|
|
This function carries the whole cost of reading a branch: the file row
|
|
stores no payload, so every open pays the base load and the replay. It
|
|
therefore reports its own duration and the depth of the log it
|
|
replayed, because the depth is what predicts the cost, and the depth is
|
|
the quantity `files_branch.clj::check-oplog-depth-limit!` gates. The
|
|
same numbers travel on the returned file's metadata as `::audit/props`,
|
|
so the RPC command that paid for the derive reports them on its own
|
|
audit event. An ordinary file read never reaches this function, so an
|
|
ordinary read neither times nor logs anything.
|
|
|
|
With `include-base-data?` true the returned file also carries the
|
|
merge-base document under `::base-data`, migrated to the current data
|
|
version (`migrate-branch-base`), the version `get-file` brings main and
|
|
the branch to. A caller that is about to compare the branch with its
|
|
base reads the branch file with that flag and takes the value, and it
|
|
never decodes the same snapshot a second time."
|
|
[{:keys [::db/conn] :as cfg} {:keys [id] :as file} decode? include-base-data?]
|
|
(let [tpoint (ct/tpoint)
|
|
|
|
branch (db/get* conn :file-branch {:branch-file-id id})
|
|
|
|
_ (when (nil? branch)
|
|
(ex/raise :type :not-found
|
|
:code :branch-metadata-missing
|
|
:hint "branch metadata not found for branch file"
|
|
:file-id id))
|
|
|
|
base (db/get-with-sql cfg
|
|
[sql:get-branch-base-snapshot
|
|
(:source-file-id branch)
|
|
(:base-snapshot-id branch)
|
|
(ct/now)]
|
|
{::db/remove-deleted false})
|
|
|
|
_ (when (nil? base)
|
|
(ex/raise :type :not-found
|
|
:code :base-snapshot-missing
|
|
:hint "the branch merge-base snapshot cannot be resolved"
|
|
:file-id id))
|
|
|
|
;; same decode `fsnap/get-snapshot` applies: storage-backed
|
|
;; snapshots carry the storage ref inside :metadata, so it must
|
|
;; be decoded before `resolve-file-data` can fetch the object.
|
|
;; NOTE the (cfg file) argument order of both fdata fns: the
|
|
;; snapshot row is the FILE argument, never the cfg.
|
|
base (-> base
|
|
(d/update-when :metadata fdata/decode-metadata))
|
|
|
|
base (if (nil? (:migrations base))
|
|
(dissoc base :migrations)
|
|
(update base :migrations db/pgarray->set))
|
|
|
|
base (fdata/resolve-file-data cfg base)
|
|
base (fdata/decode-file-data cfg base)
|
|
|
|
rows (db/exec! conn [sql:get-branch-changes id])
|
|
|
|
;; the document the replay works on: the merge base at the
|
|
;; base's data version, under the branch file's identity, so a
|
|
;; migration on the way resolves the branch's libraries
|
|
doc (-> file
|
|
(assoc :data (:data base))
|
|
(assoc :version (or (:version base) (:version file)))
|
|
(assoc :migrations (:migrations base)))
|
|
|
|
;; the derive replays the log batch by batch, so each batch is
|
|
;; decoded exactly once. `depth` is the flattened op count, the
|
|
;; quantity `files_branch.clj::check-oplog-depth-limit!` limits,
|
|
;; and the one that predicts the cost of the replay.
|
|
;;
|
|
;; A row's `data_version` is the version its changes were
|
|
;; written at; the document migrates to it before the row
|
|
;; applies, and in the steady state that check is one set
|
|
;; lookup. A NULL stamp marks a row written before the column
|
|
;; existed: it replays at the version the document holds, which
|
|
;; is the base's version, because such rows precede every
|
|
;; stamped row of their log. That is how the derive replayed
|
|
;; every row before the column existed.
|
|
[doc depth]
|
|
(reduce (fn [[doc depth] {:keys [changes data-version]}]
|
|
(let [changes (blob/decode changes)
|
|
doc (if (fmg/need-migration-to? doc data-version)
|
|
(migrate-detached cfg doc #(fmg/migrate-file-to %1 %2 data-version))
|
|
doc)]
|
|
[(update doc :data cpc/process-changes changes)
|
|
(+ depth (count changes))]))
|
|
[doc 0]
|
|
rows)
|
|
|
|
data (cond-> (:data doc)
|
|
(not decode?) (blob/encode))
|
|
|
|
;; the comparison's `base` is the merge base before the replay,
|
|
;; at the version main and the branch are read at. The replay
|
|
;; returns the branch's own state in `data`, so a comparison
|
|
;; handed `data` as its base would compare the branch with
|
|
;; itself.
|
|
base-data (when include-base-data?
|
|
(migrate-branch-base cfg base))
|
|
|
|
;; measured once so the log line and the audit props carry the same
|
|
;; number. The timer covers the re-encode as well when the caller
|
|
;; asked for raw bytes: that encode is part of what it waits for.
|
|
duration (inst-ms (tpoint))]
|
|
|
|
(l/inf :hint "branch file derive"
|
|
:file-id (str id)
|
|
:oplog-depth depth
|
|
:oplog-batches (count rows)
|
|
:duration-ms duration)
|
|
|
|
(-> file
|
|
;; the derived data carries the version and migration set the
|
|
;; replay ended at: the base's own while no row was written past
|
|
;; it, which keeps `need-migration?` quiet in the steady state,
|
|
;; and a later one when the replay crossed an upgrade
|
|
(assoc :data data)
|
|
(assoc :version (:version doc))
|
|
(assoc :features (:features doc))
|
|
(cond-> (some? (:migrations doc))
|
|
(assoc :migrations (:migrations doc)))
|
|
(cond-> include-base-data?
|
|
(assoc ::base-data base-data))
|
|
;; the numbers travel with the value, because the RPC audit event
|
|
;; of the read that paid for this derive reads `::audit/props` off
|
|
;; the result metadata
|
|
;; (`app/loggers/audit.clj::prepare-rpc-event`), and a branch open
|
|
;; returns exactly this file. An ordinary file never reaches this
|
|
;; function, so an ordinary read attaches nothing.
|
|
(vary-meta assoc ::audit/props
|
|
{:branch-derive-ms duration
|
|
:branch-oplog-depth depth
|
|
:branch-oplog-batches (count rows)}))))
|
|
|
|
(defn- get-file*
|
|
[{:keys [::db/conn] :as cfg} id
|
|
{:keys [migrate?
|
|
realize?
|
|
decode?
|
|
skip-locked?
|
|
include-deleted?
|
|
load-data?
|
|
throw-if-not-exists?
|
|
lock-for-update?
|
|
lock-for-share?
|
|
include-base-data?]
|
|
:or {lock-for-update? false
|
|
lock-for-share? false
|
|
load-data? true
|
|
migrate? true
|
|
decode? true
|
|
include-deleted? false
|
|
throw-if-not-exists? true
|
|
realize? false
|
|
include-base-data? false}
|
|
:as options}]
|
|
|
|
(assert (db/connection? conn) "expected cfg with valid connection")
|
|
(when (and (not load-data?)
|
|
(or lock-for-share? lock-for-share? skip-locked?))
|
|
(throw (IllegalArgumentException. "locking is incompatible when `load-data?` is false")))
|
|
|
|
(let [sql
|
|
(if load-data?
|
|
sql:get-file
|
|
sql:get-file-without-data)
|
|
|
|
sql
|
|
(cond
|
|
lock-for-update?
|
|
(str sql " FOR UPDATE of f")
|
|
|
|
lock-for-share?
|
|
(str sql " FOR SHARE of f")
|
|
|
|
:else
|
|
sql)
|
|
|
|
sql
|
|
(if skip-locked?
|
|
(str sql " SKIP LOCKED")
|
|
sql)
|
|
|
|
file
|
|
(db/get-with-sql conn [sql id]
|
|
{::db/throw-if-not-exists false
|
|
::db/remove-deleted (not include-deleted?)})
|
|
|
|
file
|
|
(-> file
|
|
(d/update-when :features db/decode-pgarray #{})
|
|
(d/update-when :metadata fdata/decode-metadata))]
|
|
|
|
(if file
|
|
(if load-data?
|
|
(let [branch? (:is-branch file)
|
|
|
|
file
|
|
(if branch?
|
|
(branch-file-data cfg file decode? include-base-data?)
|
|
(->> file
|
|
(fmigr/resolve-applied-migrations cfg)
|
|
(fdata/resolve-file-data cfg)))
|
|
|
|
;; a branch file derives its data from the pinned base
|
|
;; snapshot and the op log; data migrations apply in
|
|
;; memory only (read-only) so the derived state stays
|
|
;; current without persisting a data payload
|
|
will-migrate?
|
|
(and migrate? (fmg/need-migration? file))]
|
|
|
|
(if decode?
|
|
(cond->> (fdata/decode-file-data cfg file)
|
|
(and realize? (not will-migrate?))
|
|
(fdata/realize cfg)
|
|
|
|
will-migrate?
|
|
(migrate-file cfg (cond-> options
|
|
branch? (assoc :read-only? true))))
|
|
|
|
file))
|
|
file)
|
|
|
|
(when-not (or skip-locked? (not throw-if-not-exists?))
|
|
(ex/raise :type :not-found
|
|
:code :object-not-found
|
|
:hint "database object not found"
|
|
:table :file
|
|
:file-id id)))))
|
|
|
|
(defn get-file
|
|
"Get file, resolve all features and apply migrations.
|
|
|
|
Useful when you have plan to apply massive or not surgical
|
|
operations on file, because it removes the overhead of lazy fetching
|
|
and decoding."
|
|
[cfg file-id & {:as opts}]
|
|
(db/run! cfg get-file* file-id opts))
|
|
|
|
(defn clean-file-features
|
|
[file]
|
|
(update file :features (fn [features]
|
|
(if (set? features)
|
|
(-> features
|
|
(cfeat/migrate-legacy-features)
|
|
(set/difference cfeat/frontend-only-features)
|
|
(set/difference cfeat/backend-only-features))
|
|
#{}))))
|
|
|
|
(defn check-file-exists
|
|
[cfg id & {:keys [include-deleted?]
|
|
:or {include-deleted? false}
|
|
:as options}]
|
|
(db/get-with-sql cfg [sql:get-minimal-file id]
|
|
{:db/remove-deleted (not include-deleted?)}))
|
|
|
|
(def ^:private sql:file-permissions
|
|
"select fpr.is_owner,
|
|
fpr.is_admin,
|
|
fpr.can_edit
|
|
from file_profile_rel as fpr
|
|
inner join file as f on (f.id = fpr.file_id)
|
|
where fpr.file_id = ?
|
|
and fpr.profile_id = ?
|
|
union all
|
|
select tpr.is_owner,
|
|
tpr.is_admin,
|
|
tpr.can_edit
|
|
from team_profile_rel as tpr
|
|
inner join project as p on (p.team_id = tpr.team_id)
|
|
inner join file as f on (p.id = f.project_id)
|
|
where f.id = ?
|
|
and tpr.profile_id = ?
|
|
union all
|
|
select ppr.is_owner,
|
|
ppr.is_admin,
|
|
ppr.can_edit
|
|
from project_profile_rel as ppr
|
|
inner join file as f on (f.project_id = ppr.project_id)
|
|
where f.id = ?
|
|
and ppr.profile_id = ?")
|
|
|
|
(defn- get-file-permissions*
|
|
[conn profile-id file-id]
|
|
(when (and profile-id file-id)
|
|
(db/exec! conn [sql:file-permissions
|
|
file-id profile-id
|
|
file-id profile-id
|
|
file-id profile-id])))
|
|
|
|
(defn get-file-permissions
|
|
([conn profile-id file-id]
|
|
(let [rows (get-file-permissions* conn profile-id file-id)
|
|
is-owner (boolean (some :is-owner rows))
|
|
is-admin (boolean (some :is-admin rows))
|
|
can-edit (boolean (some :can-edit rows))]
|
|
(when (seq rows)
|
|
{:type :membership
|
|
:is-owner is-owner
|
|
:is-admin (or is-owner is-admin)
|
|
:can-edit (or is-owner is-admin can-edit)
|
|
:can-read true
|
|
:is-logged (some? profile-id)})))
|
|
|
|
([conn profile-id file-id share-id]
|
|
(let [perms (get-file-permissions conn profile-id file-id)
|
|
ldata (some-> (db/get* conn :share-link {:id share-id :file-id file-id})
|
|
(dissoc :flags)
|
|
(update :pages db/decode-pgarray #{}))]
|
|
|
|
;; NOTE: in a future when share-link becomes more powerful and
|
|
;; will allow us specify which parts of the app is available, we
|
|
;; will probably need to tweak this function in order to expose
|
|
;; this flags to the frontend.
|
|
(cond
|
|
(some? perms) perms
|
|
(some? ldata) {:type :share-link
|
|
:can-read true
|
|
:pages (:pages ldata)
|
|
:is-logged (some? profile-id)
|
|
:who-comment (:who-comment ldata)
|
|
:who-inspect (:who-inspect ldata)}))))
|
|
|
|
|
|
(defn get-project
|
|
[cfg project-id]
|
|
(db/get cfg :project {:id project-id}))
|
|
|
|
(def ^:private sql:get-teams
|
|
"SELECT t.* FROM team WHERE id = ANY(?)")
|
|
|
|
(defn get-teams
|
|
[cfg ids]
|
|
(let [conn (db/get-connection cfg)
|
|
ids (db/create-array conn "uuid" ids)]
|
|
(->> (db/exec! conn [sql:get-teams ids])
|
|
(map decode-row-features))))
|
|
|
|
(defn get-team
|
|
[cfg team-id]
|
|
(-> (db/get cfg :team {:id team-id})
|
|
(decode-row-features)))
|
|
|
|
(defn get-fonts
|
|
[cfg team-id]
|
|
(db/query cfg :team-font-variant
|
|
{:team-id team-id
|
|
:deleted-at nil}))
|
|
|
|
(defn get-files-rels
|
|
"Given a set of file-id's, return all matching relations with the libraries"
|
|
[cfg ids]
|
|
|
|
(assert (set? ids) "expected a set of uuids")
|
|
(assert (every? uuid? ids) "expected a set of uuids")
|
|
|
|
(db/run! cfg (fn [{:keys [::db/conn]}]
|
|
(let [ids (db/create-array conn "uuid" ids)
|
|
sql (str "SELECT flr.*,"
|
|
" fls.synced_at"
|
|
" FROM file_library_rel AS flr"
|
|
" JOIN file AS l"
|
|
" ON flr.library_file_id = l.id"
|
|
" LEFT JOIN file_library_sync AS fls"
|
|
" ON fls.file_id = flr.file_id"
|
|
" AND fls.library_file_id = flr.library_file_id"
|
|
" WHERE flr.file_id = ANY(?)"
|
|
" AND l.deleted_at IS NULL;")]
|
|
(db/exec! conn [sql ids])))))
|
|
|
|
(def ^:private sql:upsert-file-library-sync
|
|
"INSERT INTO file_library_sync (file_id, library_file_id, synced_at)
|
|
VALUES (?::uuid, ?::uuid, ?::timestamptz)
|
|
ON CONFLICT (file_id, library_file_id)
|
|
DO UPDATE SET synced_at = EXCLUDED.synced_at;")
|
|
|
|
(defn upsert-file-library-sync!
|
|
[conn {:keys [file-id library-file-id synced-at]}]
|
|
(db/exec-one! conn [sql:upsert-file-library-sync file-id library-file-id synced-at]))
|
|
|
|
(def ^:private sql:get-libraries
|
|
"WITH RECURSIVE libs AS (
|
|
SELECT fl.id
|
|
FROM file AS fl
|
|
JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
|
|
WHERE flr.file_id = ANY(?)
|
|
UNION
|
|
SELECT fl.id
|
|
FROM file AS fl
|
|
JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
|
|
JOIN libs AS l ON (flr.file_id = l.id)
|
|
)
|
|
SELECT DISTINCT l.id
|
|
FROM libs AS l")
|
|
|
|
(defn get-libraries
|
|
"Get all libraries ids related to provided file ids"
|
|
[cfg ids]
|
|
(db/run! cfg (fn [{:keys [::db/conn]}]
|
|
(let [ids' (db/create-array conn "uuid" ids)]
|
|
(->> (db/exec! conn [sql:get-libraries ids'])
|
|
(into #{} xf-map-id))))))
|
|
|
|
(defn get-file-object-thumbnails
|
|
"Return all file object thumbnails for a given file."
|
|
[cfg file-id]
|
|
(->> (db/query cfg :file-tagged-object-thumbnail
|
|
{:file-id file-id
|
|
:deleted-at nil})
|
|
(not-empty)))
|
|
|
|
(defn get-file-thumbnail
|
|
"Return the thumbnail for the specified file-id"
|
|
[cfg {:keys [id revn]}]
|
|
(db/get* cfg :file-thumbnail
|
|
{:file-id id
|
|
:revn revn
|
|
: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 != ?")
|
|
|
|
(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. Returns a tuple of the
|
|
fixed file and the id remapping the fix applied ({foreign-id ->
|
|
copy-id}): the file data is rewritten in-place, but a caller that
|
|
persists a change vector instead of the data (the branch save path)
|
|
has to record the same remap in it, or its derive reproduces the
|
|
unfixed references."
|
|
[{: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]))
|
|
|
|
lookup-index
|
|
(fn [id]
|
|
(if-let [mobj (get missing-index id)]
|
|
(do
|
|
(l/trc :hint "lookup index"
|
|
:file-id (str file-id)
|
|
: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-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)
|
|
:old-id (str old-id)
|
|
:id (str (:id item)))
|
|
(db/insert! conn :file-media-object item
|
|
{::db/return-keys false}))
|
|
|
|
[file (update-vals missing-index :id)]))
|
|
|
|
(def sql:get-file-media
|
|
"SELECT * FROM file_media_object WHERE id = ANY(?)")
|
|
|
|
(defn get-file-media*
|
|
[{:keys [::db/conn] :as cfg} {:keys [data id] :as file}]
|
|
(let [used (cfh/collect-used-media data)
|
|
used (db/create-array conn "uuid" used)]
|
|
(->> (db/exec! conn [sql:get-file-media used])
|
|
(mapv (fn [row] (assoc row :file-id id))))))
|
|
|
|
(defn get-file-media
|
|
[cfg file]
|
|
(db/run! cfg get-file-media* file))
|
|
|
|
(def ^:private sql:get-team-files-ids
|
|
"SELECT f.id FROM file AS f
|
|
JOIN project AS p ON (p.id = f.project_id)
|
|
WHERE p.team_id = ?
|
|
AND f.is_branch IS FALSE")
|
|
|
|
(defn get-team-files-ids
|
|
"Get a set of file ids for the specified team-id"
|
|
[{:keys [::db/conn]} team-id]
|
|
(->> (db/exec! conn [sql:get-team-files-ids team-id])
|
|
(into #{} xf-map-id)))
|
|
|
|
(def ^:private sql:get-team-projects
|
|
"SELECT p.* FROM project AS p
|
|
WHERE p.team_id = ?
|
|
AND p.deleted_at IS NULL")
|
|
|
|
(defn get-team-projects
|
|
"Get a set of project ids for the team"
|
|
[cfg team-id]
|
|
(->> (db/exec! cfg [sql:get-team-projects team-id])
|
|
(into #{} xf-map-id)))
|
|
|
|
(def ^:private sql:get-project-files
|
|
"SELECT f.id FROM file AS f
|
|
WHERE f.project_id = ?
|
|
AND f.deleted_at IS NULL
|
|
AND f.is_branch IS FALSE")
|
|
|
|
(defn get-project-files
|
|
"Get a set of file ids for the project"
|
|
[{:keys [::db/conn]} project-id]
|
|
(->> (db/exec! conn [sql:get-project-files project-id])
|
|
(into #{} xf-map-id)))
|
|
|
|
(defn remap-thumbnail-object-id
|
|
[object-id file-id]
|
|
(str/replace-first object-id #"^(.*?)/" (str file-id "/")))
|
|
|
|
(defn- relink-shapes
|
|
"A function responsible to analyze all file data and
|
|
replace the old :component-file reference with the new
|
|
ones, using the provided file-index."
|
|
[data]
|
|
(cfh/relink-refs data lookup-index))
|
|
|
|
(defn- relink-media
|
|
"A function responsible of process the :media attr of file data and
|
|
remap the old ids with the new ones."
|
|
[media]
|
|
(reduce-kv (fn [res k v]
|
|
(let [id (lookup-index k)]
|
|
(if (uuid? id)
|
|
(-> res
|
|
(assoc id (assoc v :id id))
|
|
(dissoc k))
|
|
res)))
|
|
media
|
|
media))
|
|
|
|
(defn- relink-colors
|
|
"A function responsible of process the :colors attr of file data and
|
|
remap the old ids with the new ones."
|
|
[colors]
|
|
(reduce-kv (fn [res k v]
|
|
(if (:image v)
|
|
(update-in res [k :image :id] lookup-index)
|
|
res))
|
|
colors
|
|
colors))
|
|
|
|
(defn embed-assets
|
|
[cfg data file-id]
|
|
(let [library-ids (get-libraries cfg [file-id])]
|
|
(reduce (fn [data library-id]
|
|
(if-let [library (get-file cfg library-id :include-deleted? true)]
|
|
(ctf/absorb-assets data (:data library))
|
|
data))
|
|
data
|
|
library-ids)))
|
|
|
|
(def ^:const import-transaction-timeout-ms
|
|
"Ceiling for binfile import transactions (20 minutes). Interpolated
|
|
directly into SQL: compile-time constant, never user input."
|
|
(* 20 60 1000))
|
|
|
|
(defn configure-database-timeouts!
|
|
[cfg]
|
|
(let [conn (db/get-connection cfg)]
|
|
(db/exec-one! conn [(str "SET LOCAL idle_in_transaction_session_timeout = "
|
|
import-transaction-timeout-ms)])
|
|
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
|
|
|
|
(defn process-file
|
|
[cfg {:keys [id] :as file}]
|
|
(let [libs (delay (get-resolved-file-libraries cfg file))]
|
|
(-> file
|
|
(update :data (fn [fdata]
|
|
(-> fdata
|
|
(assoc :id id)
|
|
(dissoc :recent-colors))))
|
|
(update :data (fn [fdata]
|
|
(-> fdata
|
|
(update :pages-index relink-shapes)
|
|
(update :components relink-shapes)
|
|
(update :media relink-media)
|
|
(update :colors relink-colors)
|
|
(d/without-nils))))
|
|
(fmg/migrate-file libs)
|
|
|
|
;; NOTE: this is necessary because when we just creating a new
|
|
;; file from imported artifact or cloned file there are no
|
|
;; migrations registered on the database, so we need to persist
|
|
;; all of them, not only the applied
|
|
(vary-meta dissoc ::fmg/migrated))))
|
|
|
|
(defn- encode-file
|
|
[cfg {:keys [id features] :as file}]
|
|
(let [file (if (and (contains? features "fdata/objects-map")
|
|
(:data file))
|
|
(fdata/enable-objects-map file)
|
|
file)
|
|
|
|
file (if (and (contains? features "fdata/pointer-map")
|
|
(:data file))
|
|
|
|
(binding [pmap/*tracked* (pmap/create-tracked :inherit true)]
|
|
(let [file (fdata/enable-pointer-map file)]
|
|
(fdata/persist-pointers! cfg id)
|
|
file))
|
|
file)]
|
|
|
|
(-> file
|
|
(d/update-when :features into-array)
|
|
(d/update-when :data blob/encode))))
|
|
|
|
(defn- file->params
|
|
[file]
|
|
(-> (select-keys file file-attrs)
|
|
(assoc :data nil)
|
|
(dissoc :team-id)
|
|
(dissoc :metadata)
|
|
(dissoc :migrations)))
|
|
|
|
(defn- file->file-data-params
|
|
[{:keys [id] :as file} & {:as opts}]
|
|
(let [created-at (or (:created-at file) (ct/now))
|
|
modified-at (or (:modified-at file) created-at)]
|
|
(d/without-nils
|
|
{:id id
|
|
:type "main"
|
|
:file-id id
|
|
:data (:data file)
|
|
:metadata (:metadata file)
|
|
:created-at created-at
|
|
:modified-at modified-at})))
|
|
|
|
(defn insert-file!
|
|
"Insert a new file into the database table. Expectes a not-encoded file.
|
|
Returns nil."
|
|
[{:keys [::db/conn] :as cfg} file & {:as opts}]
|
|
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
|
|
|
(when (:migrations file)
|
|
(fmigr/upsert-migrations! conn file))
|
|
|
|
(let [file (encode-file cfg file)]
|
|
(try
|
|
(db/insert! conn :file
|
|
(file->params file)
|
|
(assoc opts ::db/return-keys false))
|
|
(catch org.postgresql.util.PSQLException cause
|
|
(if (db/duplicate-key-error? cause)
|
|
(ex/raise :type :not-found
|
|
:code :object-not-found
|
|
:hint "file already exists"
|
|
:cause cause)
|
|
(throw cause))))
|
|
|
|
(->> (file->file-data-params file)
|
|
(fdata/upsert! cfg))
|
|
|
|
nil))
|
|
|
|
(defn update-file!
|
|
"Update an existing file on the database. Expects not encoded file."
|
|
[{:keys [::db/conn] :as cfg} {:keys [id] :as file} & {:as opts}]
|
|
|
|
(if (::reset-migrations? opts false)
|
|
(fmigr/reset-migrations! conn file)
|
|
(fmigr/upsert-migrations! conn file))
|
|
|
|
(let [file
|
|
(encode-file cfg file)
|
|
|
|
file-params
|
|
(file->params (dissoc file :id))
|
|
|
|
file-data-params
|
|
(file->file-data-params file)]
|
|
|
|
(db/update! conn :file file-params
|
|
{:id id}
|
|
{::db/return-keys false})
|
|
|
|
(fdata/upsert! cfg file-data-params)
|
|
nil))
|
|
|
|
(defn insert-file-row!
|
|
"Insert only the `file` row of a new file, without writing the
|
|
`file_data` payload row. Used for branch creation: a branch stores no
|
|
data, so the create step must skip `encode-file` (its pointer-map
|
|
transform would write `file_data` rows for the branch) and the data
|
|
upsert. Returns nil."
|
|
[{:keys [::db/conn]} file & {:as opts}]
|
|
(when (:migrations file)
|
|
(fmigr/upsert-migrations! conn file))
|
|
|
|
(let [file-params (-> file
|
|
(d/update-when :features into-array)
|
|
(file->params))]
|
|
(try
|
|
(db/insert! conn :file
|
|
file-params
|
|
(assoc opts ::db/return-keys false))
|
|
(catch org.postgresql.util.PSQLException cause
|
|
(if (db/duplicate-key-error? cause)
|
|
(ex/raise :type :not-found
|
|
:code :object-not-found
|
|
:hint "file already exists"
|
|
:cause cause)
|
|
(throw cause)))))
|
|
nil)
|
|
|
|
(defn update-file-row!
|
|
"Update only the `file` row of an existing file, without touching
|
|
`file_data`. Used for branch file saves: a branch stores no data, so
|
|
the persist step must skip `encode-file` (its pointer-map transform
|
|
would write `file_data` rows for the branch) and the data upsert."
|
|
[{:keys [::db/conn] :as cfg} {:keys [id] :as file} & {:as opts}]
|
|
(if (::reset-migrations? opts false)
|
|
(fmigr/reset-migrations! conn file)
|
|
(fmigr/upsert-migrations! conn file))
|
|
|
|
(let [file-params (-> file
|
|
(d/update-when :features into-array)
|
|
(file->params)
|
|
(dissoc :id))]
|
|
(db/update! conn :file file-params
|
|
{:id id}
|
|
{::db/return-keys false})
|
|
nil))
|
|
|
|
|
|
(defn save-file!
|
|
"Applies all the final validations and perist the file, binfile
|
|
specific, should not be used outside of binfile domain.
|
|
Returns nil"
|
|
[{:keys [::timestamp] :as cfg} file & {:as opts}]
|
|
|
|
(assert (ct/inst? timestamp) "expected valid timestamp")
|
|
|
|
(let [file (-> file
|
|
(assoc :created-at timestamp)
|
|
(assoc :modified-at timestamp)
|
|
(cond-> (not (::overwrite cfg))
|
|
(assoc :ignore-sync-until (ct/plus timestamp (ct/duration {:seconds 5}))))
|
|
(update :features
|
|
(fn [features]
|
|
(-> (::features cfg #{})
|
|
(set/union features)
|
|
;; We never want to store
|
|
;; frontend-only features on file
|
|
(set/difference cfeat/frontend-only-features)))))]
|
|
|
|
(when (contains? cf/flags :file-schema-validation)
|
|
(fval/validate-file-schema! file))
|
|
|
|
(when (contains? cf/flags :soft-file-schema-validation)
|
|
(let [result (ex/try! (fval/validate-file-schema! file))]
|
|
(when (ex/exception? result)
|
|
(l/error :hint "file schema validation error" :cause result))))
|
|
|
|
(if (::overwrite cfg)
|
|
(update-file! cfg file (assoc opts ::reset-migrations? true))
|
|
(insert-file! cfg file opts))))
|
|
|
|
(def ^:private sql:get-file-libraries
|
|
"WITH RECURSIVE libs AS (
|
|
SELECT fl.*
|
|
FROM file AS fl
|
|
JOIN file_library_rel AS flr
|
|
ON flr.library_file_id = fl.id
|
|
WHERE flr.file_id = ?::uuid
|
|
|
|
UNION
|
|
|
|
SELECT fl.*
|
|
FROM file AS fl
|
|
JOIN file_library_rel AS flr
|
|
ON flr.library_file_id = fl.id
|
|
JOIN libs AS l
|
|
ON flr.file_id = l.id
|
|
)
|
|
SELECT l.id,
|
|
l.features,
|
|
l.project_id,
|
|
p.team_id,
|
|
l.created_at,
|
|
l.modified_at,
|
|
l.deleted_at,
|
|
l.name,
|
|
l.revn,
|
|
l.vern,
|
|
l.is_shared,
|
|
l.version,
|
|
fls.synced_at,
|
|
NOT EXISTS (
|
|
SELECT 1 FROM file_library_rel AS direct
|
|
WHERE direct.file_id = ?::uuid
|
|
AND direct.library_file_id = l.id
|
|
) AS is_indirect
|
|
FROM libs AS l
|
|
JOIN project AS p
|
|
ON p.id = l.project_id
|
|
LEFT JOIN file_library_sync AS fls
|
|
ON fls.file_id = ?::uuid
|
|
AND fls.library_file_id = l.id
|
|
WHERE l.deleted_at IS NULL;")
|
|
|
|
(defn get-file-libraries
|
|
[conn file-id]
|
|
(into []
|
|
(map decode-row-features)
|
|
(db/exec! conn [sql:get-file-libraries file-id file-id file-id])))
|
|
|
|
(defn get-resolved-file-libraries
|
|
"Get all file libraries including itself. Returns an instance of
|
|
LoadableWeakValueMap that allows do not have strong references to
|
|
the loaded libraries and reduce memory pressure on having
|
|
all this libraries at the same time on processing file validation
|
|
or file migration.
|
|
|
|
This still requires at least one library at time to be loaded while
|
|
access to it is performed, but it improves considerable not having
|
|
the need of loading all the libraries at the same time."
|
|
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
|
|
(let [library-ids (->> (get-file-libraries conn (:id file))
|
|
(map :id)
|
|
(cons (:id file)))
|
|
load-fn #(get-file cfg % :migrate? false)]
|
|
(weak/loadable-weak-value-map library-ids load-fn {id file})))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; EXTERNAL LIBRARY RESOLUTION HELPERS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn slugify-name
|
|
"Slugify a library name for cross-environment matching.
|
|
Lowercases, replaces non-alphanumeric runs with '-', strips
|
|
leading/trailing '-'."
|
|
[name]
|
|
(str/slug name))
|
|
|
|
(def ^:private sql:get-files-names
|
|
"SELECT id, name FROM file WHERE id = ANY(?)")
|
|
|
|
(defn get-files-names
|
|
"Return [{:id uuid :name string}] for the given file ids."
|
|
[cfg ids]
|
|
(db/run! cfg
|
|
(fn [{:keys [::db/conn]}]
|
|
(let [ids-arr (db/create-array conn "uuid" ids)]
|
|
(db/exec! conn [sql:get-files-names ids-arr])))))
|
|
|
|
(def ^:private sql:get-shared-files-for-team
|
|
"SELECT f.id, f.name, f.project_id
|
|
FROM file AS f
|
|
JOIN project AS p ON (p.id = f.project_id)
|
|
WHERE p.team_id = ?
|
|
AND f.is_shared = true
|
|
AND f.deleted_at IS NULL
|
|
AND p.deleted_at IS NULL")
|
|
|
|
(defn get-shared-files-for-team
|
|
"Return [{:id uuid :name string}] for all shared files in a team."
|
|
[cfg team-id]
|
|
(db/run! cfg
|
|
(fn [{:keys [::db/conn]}]
|
|
(db/exec! conn [sql:get-shared-files-for-team team-id]))))
|
|
|
|
(defn find-shared-files-by-slug
|
|
"Return all shared files in `team-id` whose slugified name equals `slug`."
|
|
[cfg team-id slug]
|
|
(->> (get-shared-files-for-team cfg team-id)
|
|
(filter #(= slug (slugify-name (:name %))))))
|