mirror of
https://github.com/penpot/penpot.git
synced 2025-04-04 19:11:20 -05:00
Merge remote-tracking branch 'origin/staging' into develop
This commit is contained in:
Andrey Antukh
commit
1743da7ebf
13 changed files with 591 additions and 355 deletions
|
|
@ -47,6 +47,7 @@
|
|||
([table where-params opts]
|
||||
(let [opts (merge default-opts opts)
|
||||
opts (cond-> opts
|
||||
(::order-by opts) (assoc :order-by (::order-by opts))
|
||||
(::columns opts) (assoc :columns (::columns opts))
|
||||
(::for-update opts) (assoc :suffix "FOR UPDATE")
|
||||
(::for-share opts) (assoc :suffix "FOR SHARE"))]
|
||||
|
|
|
|||
|
|
@ -55,6 +55,7 @@
|
|||
[app.util.pointer-map :as pmap]
|
||||
[app.util.time :as dt]
|
||||
[buddy.core.codecs :as bc]
|
||||
[clojure.set :refer [rename-keys]]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.io :as io]
|
||||
[promesa.exec :as px]
|
||||
|
|
@ -375,6 +376,19 @@
|
|||
:selrect selrect
|
||||
:points points))
|
||||
|
||||
(and (cfh/text-shape? shape)
|
||||
(valid-text-content? (:content shape))
|
||||
(not (valid-shape-points? (:points shape)))
|
||||
(grc/valid-rect? (:selrect shape)))
|
||||
(let [selrect (:selrect shape)
|
||||
points (grc/rect->points selrect)]
|
||||
(assoc shape
|
||||
:x (:x selrect)
|
||||
:y (:y selrect)
|
||||
:width (:width selrect)
|
||||
:height (:height selrect)
|
||||
:points points))
|
||||
|
||||
(and (or (cfh/rect-shape? shape)
|
||||
(cfh/svg-raw-shape? shape)
|
||||
(cfh/circle-shape? shape))
|
||||
|
|
@ -414,6 +428,50 @@
|
|||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))
|
||||
|
||||
fix-empty-components
|
||||
(fn [file-data]
|
||||
(letfn [(fix-component [components id component]
|
||||
(if (empty? (:objects component))
|
||||
(dissoc components id)
|
||||
components))]
|
||||
|
||||
(-> file-data
|
||||
(d/update-when :components #(reduce-kv fix-component % %)))))
|
||||
|
||||
fix-components-with-component-root
|
||||
;;In v1 no components in the library should have component-root
|
||||
(fn [file-data]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(dissoc shape :component-root))]
|
||||
|
||||
(-> file-data
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
fix-non-existing-component-ids
|
||||
;; Check component ids have valid values.
|
||||
(fn [file-data]
|
||||
(let [libraries (assoc-in libraries [(:id file-data) :data] file-data)]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(let [component-id (:component-id shape)
|
||||
component-file (:component-file shape)
|
||||
library (get libraries component-file)]
|
||||
|
||||
(cond-> shape
|
||||
(and (some? component-id)
|
||||
(some? library)
|
||||
(nil? (ctkl/get-component (:data library) component-id)))
|
||||
(ctk/detach-shape))))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container)))))
|
||||
|
||||
fix-misc-shape-issues
|
||||
(fn [file-data]
|
||||
(letfn [(fix-container [container]
|
||||
|
|
@ -899,12 +957,12 @@
|
|||
;;
|
||||
;; WARNING: THIS SHOULD BE CALLED AT THE END OF THE PROCESS.
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(cond-> shape
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
(fix-shape [container shape]
|
||||
(cond-> container
|
||||
(@detached-ids (:shape-ref shape))
|
||||
(ctk/detach-shape)))]
|
||||
(detach-shape shape)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))]
|
||||
|
|
@ -919,6 +977,9 @@
|
|||
(fix-broken-paths)
|
||||
(fix-big-geometry-shapes)
|
||||
(fix-shape-geometry)
|
||||
(fix-empty-components)
|
||||
(fix-components-with-component-root)
|
||||
(fix-non-existing-component-ids)
|
||||
(fix-completly-broken-shapes)
|
||||
(fix-bad-children)
|
||||
(fix-broken-parents)
|
||||
|
|
@ -938,8 +999,7 @@
|
|||
(fix-false-copies)
|
||||
(fix-component-root-without-component)
|
||||
(fix-copies-of-detached); <- Do not add fixes after this and fix-orphan-copies call
|
||||
; This extra call to fix-orphan-copies after fix-copies-of-detached because we can have detached subtrees with invalid shape-ref attributes
|
||||
(fix-orphan-copies))))
|
||||
)))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; COMPONENTS MIGRATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -948,6 +1008,9 @@
|
|||
[assets generic-name]
|
||||
(let [;; Group by first element of the path.
|
||||
groups (d/group-by #(first (cfh/split-path (:path %))) assets)
|
||||
;; If there is a group called as the generic-name we have to preserve it
|
||||
unames (into #{} (keep str) (keys groups))
|
||||
groups (rename-keys groups {generic-name (cfh/generate-unique-name unames generic-name)})
|
||||
|
||||
;; Split large groups in chunks of max-group-size elements
|
||||
groups (loop [groups (seq groups)
|
||||
|
|
@ -1447,7 +1510,7 @@
|
|||
(-> (db/get system :team {:id team-id}
|
||||
{::db/remove-deleted false
|
||||
::db/check-deleted false})
|
||||
(decode-row)))
|
||||
(update :features db/decode-pgarray #{})))
|
||||
|
||||
(defn- validate-file!
|
||||
[file libs]
|
||||
|
|
@ -1496,19 +1559,21 @@
|
|||
AND f.deleted_at IS NULL
|
||||
FOR UPDATE")
|
||||
|
||||
(defn get-and-lock-files
|
||||
(defn get-and-lock-team-files
|
||||
[conn team-id]
|
||||
(->> (db/cursor conn [sql:get-and-lock-team-files team-id])
|
||||
(map :id)))
|
||||
|
||||
(defn update-team!
|
||||
[conn team]
|
||||
(let [params (-> team
|
||||
[system {:keys [id] :as team}]
|
||||
(let [conn (db/get-connection system)
|
||||
params (-> team
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(dissoc :id))]
|
||||
(db/update! conn :team
|
||||
params
|
||||
{:id (:id team)})))
|
||||
{:id id})
|
||||
team))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PUBLIC API
|
||||
|
|
@ -1607,7 +1672,7 @@
|
|||
:id id})
|
||||
|
||||
(run! (partial migrate-file system)
|
||||
(get-and-lock-files conn id))
|
||||
(get-and-lock-team-files conn id))
|
||||
|
||||
(->> (assoc team :features features)
|
||||
(update-team! conn))))))]
|
||||
|
|
|
|||
|
|
@ -414,12 +414,12 @@
|
|||
:hint "provided invalid version"))
|
||||
|
||||
(binding [srepl/*system* cfg]
|
||||
(srepl/update-file! :id file-id
|
||||
:update-fn (fn [file]
|
||||
(update file :data assoc :version version))
|
||||
:migrate? false
|
||||
:inc-revn? false
|
||||
:save? true))
|
||||
(srepl/process-file! :id file-id
|
||||
:update-fn (fn [file]
|
||||
(update file :data assoc :version version))
|
||||
:migrate? false
|
||||
:inc-revn? false
|
||||
:save? true))
|
||||
{::rres/status 200
|
||||
::rres/headers {"content-type" "text/plain"}
|
||||
::rres/body "OK"}))
|
||||
|
|
|
|||
|
|
@ -285,8 +285,9 @@
|
|||
file)))
|
||||
|
||||
(defn get-minimal-file
|
||||
[{:keys [::db/pool] :as cfg} id]
|
||||
(db/get pool :file {:id id} {:columns [:id :modified-at :revn]}))
|
||||
[cfg id & {:as opts}]
|
||||
(let [opts (assoc opts ::sql/columns [:id :modified-at :revn])]
|
||||
(db/get cfg :file {:id id} opts)))
|
||||
|
||||
(defn get-file-etag
|
||||
[{:keys [::rpc/profile-id]} {:keys [modified-at revn]}]
|
||||
|
|
|
|||
|
|
@ -12,14 +12,17 @@
|
|||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
[app.main :as-alias main]
|
||||
[app.media :as media]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.rpc.commands.files :as files]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.rpc.doc :as-alias doc]
|
||||
[app.storage :as sto]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]))
|
||||
[app.util.time :as dt]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn check-authorized!
|
||||
[{:keys [::db/pool]} profile-id]
|
||||
|
|
@ -57,76 +60,119 @@
|
|||
::sm/params schema:get-file-snapshots}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/run! cfg #(get-file-snapshots % params)))
|
||||
(db/run! cfg get-file-snapshots params))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[{:keys [::db/conn ::sto/storage] :as cfg} {:keys [file-id id]}]
|
||||
(let [storage (media/configure-assets-storage storage conn)
|
||||
params {:id id :file-id file-id}
|
||||
options {:columns [:id :data :revn :features]}
|
||||
snapshot (db/get* conn :file-change params options)]
|
||||
file (files/get-minimal-file conn file-id {::db/for-update true})
|
||||
snapshot (db/get* conn :file-change
|
||||
{:file-id file-id
|
||||
:id id}
|
||||
{::db/for-share true})]
|
||||
|
||||
(when (and (some? snapshot)
|
||||
(some? (:data snapshot)))
|
||||
(when-not snapshot
|
||||
(ex/raise :type :not-found
|
||||
:code :snapshot-not-found
|
||||
:hint "unable to find snapshot with the provided label"
|
||||
:id id
|
||||
:file-id file-id))
|
||||
|
||||
(l/dbg :hint "restoring snapshot"
|
||||
:file-id (str file-id)
|
||||
:snapshot-id (str (:id snapshot)))
|
||||
(when-not (:data snapshot)
|
||||
(ex/raise :type :precondition
|
||||
:code :snapshot-without-data
|
||||
:hint "snapshot has no data"
|
||||
:label (:label snapshot)
|
||||
:file-id file-id))
|
||||
|
||||
(db/update! conn :file
|
||||
{:data (:data snapshot)
|
||||
:revn (:revn snapshot)
|
||||
:features (:features snapshot)}
|
||||
{:id file-id})
|
||||
(l/dbg :hint "restoring snapshot"
|
||||
:file-id (str file-id)
|
||||
:label (:label snapshot)
|
||||
:snapshot-id (str (:id snapshot)))
|
||||
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_tagged_object_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(db/update! conn :file
|
||||
{:data (:data snapshot)
|
||||
:revn (inc (:revn file))
|
||||
:features (:features snapshot)}
|
||||
{:id file-id})
|
||||
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_tagged_object_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
|
||||
{:id (:id snapshot)})))
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
|
||||
(def ^:private schema:restore-file-snapshot
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:id ::sm/uuid]])
|
||||
{:id (:id snapshot)
|
||||
:label (:label snapshot)}))
|
||||
|
||||
(defn- resolve-snapshot-by-label
|
||||
[conn file-id label]
|
||||
(->> (db/query conn :file-change
|
||||
{:file-id file-id
|
||||
:label label}
|
||||
{::sql/order-by [[:created-at :desc]]
|
||||
::sql/columns [:file-id :id :label]})
|
||||
(first)))
|
||||
|
||||
(def ^:private
|
||||
schema:restore-file-snapshot
|
||||
[:and
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:id {:optional true} ::sm/uuid]
|
||||
[:label {:optional true} :string]]
|
||||
[::sm/contains-any #{:id :label}]])
|
||||
|
||||
(sv/defmethod ::restore-file-snapshot
|
||||
{::doc/added "1.20"
|
||||
::doc/skip true
|
||||
::sm/params schema:restore-file-snapshot}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
[cfg {:keys [::rpc/profile-id file-id id label] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/tx-run! cfg #(restore-file-snapshot! % params)))
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [params (cond-> params
|
||||
(and (not id) (string? label))
|
||||
(merge (resolve-snapshot-by-label conn file-id label)))]
|
||||
(restore-file-snapshot! cfg params)))))
|
||||
|
||||
(defn take-file-snapshot!
|
||||
[{:keys [::db/conn]} {:keys [file-id label]}]
|
||||
(when-let [file (db/get* conn :file {:id file-id})]
|
||||
(let [id (uuid/next)
|
||||
label (or label (str "Snapshot at " (dt/format-instant (dt/now) :rfc1123)))]
|
||||
(l/debug :hint "persisting file snapshot"
|
||||
:file-id (str file-id)
|
||||
:label label)
|
||||
(db/insert! conn :file-change
|
||||
{:id id
|
||||
:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:file-id (:id file)
|
||||
:label label})
|
||||
{:id id})))
|
||||
(let [file (db/get conn :file {:id file-id})
|
||||
id (uuid/next)]
|
||||
|
||||
(l/debug :hint "creating file snapshot"
|
||||
:file-id (str file-id)
|
||||
:label label)
|
||||
|
||||
(db/insert! conn :file-change
|
||||
{:id id
|
||||
:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:file-id (:id file)
|
||||
:label label}
|
||||
{::db/return-keys false})
|
||||
|
||||
{:id id :label label}))
|
||||
|
||||
(defn generate-snapshot-label
|
||||
[]
|
||||
(let [ts (-> (dt/now)
|
||||
(dt/format-instant)
|
||||
(str/replace #"[T:\.]" "-")
|
||||
(str/rtrim "Z"))]
|
||||
(str "snapshot-" ts)))
|
||||
|
||||
(def ^:private schema:take-file-snapshot
|
||||
[:map [:file-id ::sm/uuid]])
|
||||
|
|
@ -137,5 +183,8 @@
|
|||
::sm/params schema:take-file-snapshot}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/tx-run! cfg #(take-file-snapshot! % params)))
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(let [params (update params :label (fn [label]
|
||||
(or label (generate-snapshot-label))))]
|
||||
(take-file-snapshot! cfg params)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -9,13 +9,12 @@
|
|||
[app.binfile.v2 :as binfile.v2]
|
||||
[app.db :as db]
|
||||
[app.main :as main]
|
||||
[app.srepl.helpers :as h]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn export-team!
|
||||
[team-id]
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(binfile.v2/export-team! main/system team-id)))
|
||||
|
||||
(defn import-team!
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
[app.db :as db]
|
||||
[app.features.components-v2 :as feat]
|
||||
[app.main :as main]
|
||||
[app.rpc.commands.files-snapshot :as rpc]
|
||||
[app.srepl.helpers :as h]
|
||||
[app.svgo :as svgo]
|
||||
[app.util.cache :as cache]
|
||||
[app.util.events :as events]
|
||||
|
|
@ -280,9 +280,7 @@
|
|||
skip-on-graphic-error? true}}]
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
(let [tpoint (dt/tpoint)
|
||||
file-id (if (string? file-id)
|
||||
(parse-uuid file-id)
|
||||
file-id)
|
||||
file-id (h/parse-uuid file-id)
|
||||
cache (if (int? cache)
|
||||
(cache/create :executor (::wrk/executor main/system)
|
||||
:max-items cache)
|
||||
|
|
@ -315,9 +313,7 @@
|
|||
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
stats (atom {})
|
||||
tpoint (dt/tpoint)
|
||||
|
||||
|
|
@ -637,44 +633,3 @@
|
|||
:file-name (:name file))
|
||||
(assoc file :deleted-at (dt/now)))
|
||||
file))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; RESTORE SNAPSHOT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ^:private sql:snapshots-with-file
|
||||
"SELECT f.id AS file_id,
|
||||
fc.id AS id
|
||||
FROM file AS f
|
||||
JOIN file_change AS fc ON (fc.file_id = f.id)
|
||||
WHERE fc.label = ? AND f.id = ANY(?)")
|
||||
|
||||
(defn restore-team!
|
||||
[team-id label & {:keys [rollback?] :or {rollback? true}}]
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)
|
||||
|
||||
get-file-snapshots
|
||||
(fn [conn ids]
|
||||
(let [label (str "migration/" label)]
|
||||
(db/exec! conn [sql:snapshots-with-file label
|
||||
(db/create-array conn "uuid" ids)])))
|
||||
|
||||
restore-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [ids (into #{} (feat/get-and-lock-files conn team-id))
|
||||
snap (get-file-snapshots conn ids)
|
||||
ids' (into #{} (map :file-id) snap)
|
||||
team (-> (feat/get-team conn team-id)
|
||||
(update :features disj "components/v2"))]
|
||||
|
||||
(when (not= ids ids')
|
||||
(throw (RuntimeException. "no uniform snapshot available")))
|
||||
|
||||
(feat/update-team! conn team)
|
||||
(run! (partial rpc/restore-file-snapshot! system) snap)))]
|
||||
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! restore-snapshot))))
|
||||
|
|
|
|||
|
|
@ -15,9 +15,7 @@
|
|||
[app.common.features :as cfeat]
|
||||
[app.common.files.changes :as cpc]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.files.repair :as repair]
|
||||
[app.common.files.validate :as cfv]
|
||||
[app.common.files.validate :as validate]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :refer [pprint]]
|
||||
[app.common.spec :as us]
|
||||
|
|
@ -52,9 +50,78 @@
|
|||
|
||||
(defn parse-uuid
|
||||
[v]
|
||||
(if (uuid? v)
|
||||
v
|
||||
(d/parse-uuid v)))
|
||||
(if (string? v)
|
||||
(d/parse-uuid v)
|
||||
v))
|
||||
|
||||
;; (def ^:private sql:get-and-lock-team-files
|
||||
;; "SELECT f.id
|
||||
;; FROM file AS f
|
||||
;; JOIN project AS p ON (p.id = f.project_id)
|
||||
;; WHERE p.team_id = ?
|
||||
;; FOR UPDATE")
|
||||
|
||||
;; (defn get-and-lock-team-files
|
||||
;; [conn team-id]
|
||||
;; (->> (db/exec! conn [sql:get-and-lock-team-files team-id])
|
||||
;; (into #{} (map :id))))
|
||||
|
||||
;; (defn get-team
|
||||
;; [system team-id]
|
||||
;; (-> (db/get system :team {:id team-id}
|
||||
;; {::db/remove-deleted false
|
||||
;; ::db/check-deleted false})
|
||||
;; (update :features db/decode-pgarray #{})))
|
||||
|
||||
(defn get-file
|
||||
"Get the migrated data of one file."
|
||||
([id] (get-file (or *system* main/system) id))
|
||||
([system id]
|
||||
(db/run! system
|
||||
(fn [system]
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
|
||||
(-> (files/get-file system id :migrate? false)
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(update :data feat.fdata/process-objects (partial into {}))
|
||||
(fmg/migrate-file)))))))
|
||||
|
||||
(defn update-file!
|
||||
[system {:keys [id] :as file}]
|
||||
(let [conn (db/get-connection system)
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)
|
||||
|
||||
file (-> file
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(update :data blob/encode))]
|
||||
|
||||
(db/update! conn :file
|
||||
{:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:data-backend nil
|
||||
:modified-at (dt/now)
|
||||
:has-media-trimmed false}
|
||||
{:id (:id file)})))
|
||||
|
||||
(defn update-team!
|
||||
[system {:keys [id] :as team}]
|
||||
(let [conn (db/get-connection system)
|
||||
params (-> team
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(dissoc :id))]
|
||||
(db/update! conn :team
|
||||
params
|
||||
{:id id})
|
||||
team))
|
||||
|
||||
(defn reset-file-data!
|
||||
"Hardcode replace of the data of one file."
|
||||
|
|
@ -65,111 +132,27 @@
|
|||
{:data data}
|
||||
{:id id}))))
|
||||
|
||||
(defn- get-file*
|
||||
"Get the migrated data of one file."
|
||||
[system id]
|
||||
(db/run! system
|
||||
(fn [system]
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
|
||||
(-> (files/get-file system id :migrate? false)
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(update :data feat.fdata/process-objects (partial into {}))
|
||||
(fmg/migrate-file))))))
|
||||
(defn process-file*
|
||||
[system file-id update-fn]
|
||||
(let [file (get-file system file-id)
|
||||
file (-> (update-fn file)
|
||||
(update :revn inc))]
|
||||
|
||||
(defn get-file
|
||||
"Get the migrated data of one file."
|
||||
[id]
|
||||
(get-file* main/system id))
|
||||
(cfv/validate-file-schema! file)
|
||||
(update-file! system file)
|
||||
(dissoc file :data)))
|
||||
|
||||
(defn validate
|
||||
"Validate structure, referencial integrity and semantic coherence of
|
||||
all contents of a file. Returns a list of errors."
|
||||
[id]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [id (if (string? id) (parse-uuid id) id)
|
||||
file (get-file* system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(d/index-by :id))]
|
||||
(validate/validate-file file libs)))))
|
||||
|
||||
(defn repair!
|
||||
"Repair the list of errors detected by validation."
|
||||
[id]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [id (if (string? id) (parse-uuid id) id)
|
||||
file (get-file* system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(d/index-by :id))
|
||||
errors (validate/validate-file file libs)
|
||||
changes (repair/repair-file file libs errors)
|
||||
|
||||
file (-> file
|
||||
(update :revn inc)
|
||||
(update :data cpc/process-changes changes))
|
||||
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)]
|
||||
|
||||
(db/update! conn :file
|
||||
{:revn (:revn file)
|
||||
:data (blob/encode (:data file))
|
||||
:data-backend nil
|
||||
:modified-at (dt/now)
|
||||
:has-media-trimmed false}
|
||||
{:id (:id file)})
|
||||
|
||||
:repaired))))
|
||||
|
||||
|
||||
(defn update-file!
|
||||
(defn process-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."
|
||||
[& {:keys [update-fn id rollback? inc-revn?]
|
||||
:or {rollback? true inc-revn? true}}]
|
||||
(letfn [(process-file [{:keys [::db/conn] :as system} file-id]
|
||||
(let [file (get-file* system file-id)
|
||||
file (cond-> (update-fn file)
|
||||
inc-revn? (update :revn inc))
|
||||
[& {:keys [update-fn id rollback?]
|
||||
:or {rollback? true}}]
|
||||
|
||||
_ (cfv/validate-file-schema! file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)]
|
||||
|
||||
(db/update! conn :file
|
||||
{:data (blob/encode (:data file))
|
||||
:features (db/create-array conn "text" (:features file))
|
||||
:revn (:revn file)}
|
||||
{:id (:id file)})
|
||||
|
||||
(dissoc file :data)))]
|
||||
|
||||
(db/tx-run! (or *system* (assoc main/system ::db/rollback rollback?))
|
||||
(let [system (or *system* (assoc main/system ::db/rollback rollback?))]
|
||||
(db/tx-run! system
|
||||
(fn [system]
|
||||
(binding [*system* system]
|
||||
(process-file system id))))))
|
||||
(process-file* system id update-fn))))))
|
||||
|
||||
|
||||
(def ^:private sql:get-file-ids
|
||||
|
|
@ -196,11 +179,11 @@
|
|||
(strace/print-stack-trace cause))
|
||||
|
||||
(process-file [{:keys [::db/conn] :as system} file-id]
|
||||
(let [file (get-file* system file-id)
|
||||
(let [file (get-file system file-id)
|
||||
libs (when with-libraries?
|
||||
(->> (files/get-file-libraries conn file-id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(get-file system id))))
|
||||
(d/index-by :id)))]
|
||||
(try
|
||||
(if with-libraries?
|
||||
|
|
@ -220,38 +203,6 @@
|
|||
(when (fn? on-end)
|
||||
(ex/ignoring (on-end)))))))))
|
||||
|
||||
(defn repair-file-media
|
||||
[{:keys [id data] :as file}]
|
||||
(let [conn (db/get-connection *system*)
|
||||
used (bfc/collect-used-media data)
|
||||
ids (db/create-array conn "uuid" used)
|
||||
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
|
||||
rows (db/exec! conn [sql ids])
|
||||
index (reduce (fn [index media]
|
||||
(if (not= (:file-id media) id)
|
||||
(let [media-id (uuid/next)]
|
||||
(l/wrn :hint "found not referenced media"
|
||||
:file-id (str id)
|
||||
:media-id (str (:id media)))
|
||||
|
||||
(db/insert! *system* :file-media-object
|
||||
(-> media
|
||||
(assoc :file-id id)
|
||||
(assoc :id media-id)))
|
||||
(assoc index (:id media) media-id))
|
||||
index))
|
||||
{}
|
||||
rows)]
|
||||
|
||||
(when (seq index)
|
||||
(binding [bfc/*state* (atom {:index index})]
|
||||
(update file :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index #'bfc/relink-shapes)
|
||||
(update :components #'bfc/relink-shapes)
|
||||
(update :media #'bfc/relink-media)
|
||||
(d/without-nils))))))))
|
||||
|
||||
(defn process-files!
|
||||
"Apply a function to all files in the database"
|
||||
[& {:keys [max-items
|
||||
|
|
@ -281,7 +232,7 @@
|
|||
(l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [file' (get-file* system file-id)
|
||||
(let [file' (get-file system file-id)
|
||||
file (binding [*system* system]
|
||||
(on-file file'))]
|
||||
|
||||
|
|
@ -350,3 +301,37 @@
|
|||
:rollback rollback?
|
||||
:elapsed elapsed))))))
|
||||
|
||||
|
||||
(defn repair-file-media
|
||||
"A helper intended to be used with `process-files!` that fixes all
|
||||
not propertly referenced file-media-object for a file"
|
||||
[{:keys [id data] :as file}]
|
||||
(let [conn (db/get-connection *system*)
|
||||
used (bfc/collect-used-media data)
|
||||
ids (db/create-array conn "uuid" used)
|
||||
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
|
||||
rows (db/exec! conn [sql ids])
|
||||
index (reduce (fn [index media]
|
||||
(if (not= (:file-id media) id)
|
||||
(let [media-id (uuid/next)]
|
||||
(l/wrn :hint "found not referenced media"
|
||||
:file-id (str id)
|
||||
:media-id (str (:id media)))
|
||||
|
||||
(db/insert! *system* :file-media-object
|
||||
(-> media
|
||||
(assoc :file-id id)
|
||||
(assoc :id media-id)))
|
||||
(assoc index (:id media) media-id))
|
||||
index))
|
||||
{}
|
||||
rows)]
|
||||
|
||||
(when (seq index)
|
||||
(binding [bfc/*state* (atom {:index index})]
|
||||
(update file :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index #'bfc/relink-shapes)
|
||||
(update :components #'bfc/relink-shapes)
|
||||
(update :media #'bfc/relink-media)
|
||||
(d/without-nils))))))))
|
||||
|
|
|
|||
|
|
@ -13,16 +13,21 @@
|
|||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.changes :as cpc]
|
||||
[app.common.files.repair :as cfr]
|
||||
[app.common.files.validate :as cfv]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as p]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.features.fdata :as features.fdata]
|
||||
[app.features.components-v2 :as feat.comp-v2]
|
||||
[app.features.fdata :as feat.fdata]
|
||||
[app.main :as main]
|
||||
[app.msgbus :as mbus]
|
||||
[app.rpc.commands.auth :as auth]
|
||||
[app.rpc.commands.files :as files]
|
||||
[app.rpc.commands.files-snapshot :as fsnap]
|
||||
[app.rpc.commands.management :as mgmt]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
|
|
@ -38,7 +43,11 @@
|
|||
[clojure.tools.namespace.repl :as repl]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn print-available-tasks
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TASKS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn print-tasks
|
||||
[]
|
||||
(let [tasks (:app.worker/registry main/system)]
|
||||
(p/pprint (keys tasks) :level 200)))
|
||||
|
|
@ -84,6 +93,10 @@
|
|||
(auth/send-email-verification! pool sprops profile)
|
||||
:email-sent))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PROFILES MANAGEMENT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn mark-profile-as-active!
|
||||
"Mark the profile blocked and removes all the http sessiones
|
||||
associated with the profile-id."
|
||||
|
|
@ -121,19 +134,28 @@
|
|||
(let [email (str/lower email)]
|
||||
(db/exec! conn ["update profile set password=? where email=?" password email]))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FEATURES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-objects-map-feature-on-file!
|
||||
[& {:keys [save? id]}]
|
||||
(h/update-file! main/system
|
||||
:id id
|
||||
:update-fn features.fdata/enable-objects-map
|
||||
:save? save?))
|
||||
(h/process-file! main/system
|
||||
:id id
|
||||
:update-fn feat.fdata/enable-objects-map
|
||||
:save? save?))
|
||||
|
||||
(defn enable-pointer-map-feature-on-file!
|
||||
[& {:keys [save? id]}]
|
||||
(h/update-file! main/system
|
||||
:id id
|
||||
:update-fn features.fdata/enable-pointer-map
|
||||
:save? save?))
|
||||
(h/process-file! main/system
|
||||
:id id
|
||||
:update-fn feat.fdata/enable-pointer-map
|
||||
:save? save?))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[& {:as params}]
|
||||
(enable-objects-map-feature-on-file! main/system params)
|
||||
(enable-pointer-map-feature-on-file! main/system params))
|
||||
|
||||
(defn enable-team-feature!
|
||||
[team-id feature]
|
||||
|
|
@ -141,9 +163,7 @@
|
|||
"feature should be supported"
|
||||
(contains? cfeat/supported-features feature))
|
||||
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(let [team (-> (db/get conn :team {:id team-id})
|
||||
|
|
@ -161,9 +181,7 @@
|
|||
"feature should be supported"
|
||||
(contains? cfeat/supported-features feature))
|
||||
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(let [team (-> (db/get conn :team {:id team-id})
|
||||
|
|
@ -175,57 +193,10 @@
|
|||
{:id team-id})
|
||||
:disabled))))))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[& {:as params}]
|
||||
(enable-objects-map-feature-on-file! main/system params)
|
||||
(enable-pointer-map-feature-on-file! main/system params))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; NOTIFICATIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn instrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(let [mf (meta f)]
|
||||
(if (::original mf)
|
||||
f
|
||||
(with-meta
|
||||
(fn [& params]
|
||||
(tap> params)
|
||||
(let [result (apply f params)]
|
||||
(tap> result)
|
||||
result))
|
||||
{::original f}))))))
|
||||
|
||||
(defn uninstrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(or (::original (meta f)) f))))
|
||||
|
||||
(defn take-file-snapshot!
|
||||
"An internal helper that persist the file snapshot using non-gc
|
||||
collectable file-changes entry."
|
||||
[& {:keys [file-id label]}]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[& {:keys [file-id id]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [cfg]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
id (h/parse-uuid id)]
|
||||
|
||||
(if (and (uuid? id) (uuid? file-id))
|
||||
(fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
|
||||
(println "=> invalid parameters"))))))
|
||||
|
||||
|
||||
(defn list-file-snapshots!
|
||||
[& {:keys [file-id limit]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [system]
|
||||
(let [params {:file-id (h/parse-uuid file-id)
|
||||
:limit limit}]
|
||||
(->> (fsnap/get-file-snapshots system (d/without-nils params))
|
||||
(print-table [:id :revn :created-at :label]))))))
|
||||
|
||||
(defn notify!
|
||||
[{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
|
||||
|
|
@ -262,18 +233,13 @@
|
|||
{:columns [:profile-id]})
|
||||
(map :profile-id)))
|
||||
|
||||
(parse-uuid [v]
|
||||
(if (uuid? v)
|
||||
v
|
||||
(d/parse-uuid v)))
|
||||
|
||||
(resolve-dest [dest]
|
||||
(cond
|
||||
(uuid? dest)
|
||||
[dest]
|
||||
|
||||
(string? dest)
|
||||
(some-> dest parse-uuid resolve-dest)
|
||||
(some-> dest h/parse-uuid resolve-dest)
|
||||
|
||||
(nil? dest)
|
||||
(resolve-dest uuid/zero)
|
||||
|
|
@ -311,18 +277,18 @@
|
|||
(coll? param)
|
||||
(sequence (comp
|
||||
(mapcat resolve-team)
|
||||
(keep parse-uuid))
|
||||
(keep h/parse-uuid))
|
||||
param)
|
||||
|
||||
(uuid? param)
|
||||
(resolve-team param)
|
||||
|
||||
(string? param)
|
||||
(some-> param parse-uuid resolve-team))
|
||||
(some-> param h/parse-uuid resolve-team))
|
||||
|
||||
(= op :profile-id)
|
||||
(if (coll? param)
|
||||
(sequence (keep parse-uuid) param)
|
||||
(sequence (keep h/parse-uuid) param)
|
||||
(resolve-dest param))))))]
|
||||
|
||||
(->> (resolve-dest dest)
|
||||
|
|
@ -330,9 +296,194 @@
|
|||
(into #{})
|
||||
(run! send))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SNAPSHOTS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn take-file-snapshot!
|
||||
"An internal helper that persist the file snapshot using non-gc
|
||||
collectable file-changes entry."
|
||||
[& {:keys [file-id label]}]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[& {:keys [file-id id]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [cfg]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
id (h/parse-uuid id)]
|
||||
(if (and (uuid? id) (uuid? file-id))
|
||||
(fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
|
||||
(println "=> invalid parameters"))))))
|
||||
|
||||
|
||||
(defn list-file-snapshots!
|
||||
[& {:keys [file-id limit]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [system]
|
||||
(let [params {:file-id (h/parse-uuid file-id)
|
||||
:limit limit}]
|
||||
(->> (fsnap/get-file-snapshots system (d/without-nils params))
|
||||
(print-table [:id :revn :created-at :label]))))))
|
||||
|
||||
(defn take-team-snapshot!
|
||||
[& {:keys [team-id label rollback?]
|
||||
:or {rollback? true}}]
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
label (or label (fsnap/generate-snapshot-label))
|
||||
|
||||
take-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
|
||||
(map (fn [file-id]
|
||||
{:file-id file-id
|
||||
:label label}))
|
||||
(run! (partial fsnap/take-file-snapshot! system))))]
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! take-snapshot))))
|
||||
|
||||
(def ^:private sql:snapshots-with-file
|
||||
"WITH files AS (
|
||||
SELECT f.id AS file_id,
|
||||
(SELECT fc.id
|
||||
FROM file_change AS fc
|
||||
WHERE fc.label = ?
|
||||
AND fc.file_id = f.id
|
||||
ORDER BY fc.created_at DESC
|
||||
LIMIT 1) AS id
|
||||
FROM file AS f
|
||||
) SELECT * FROM files
|
||||
WHERE file_id = ANY(?)
|
||||
AND id IS NOT NULL")
|
||||
|
||||
(defn restore-team-snapshot!
|
||||
"Restore a snapshot on all files of the team. The snapshot should
|
||||
exists for all files; if is not the case, an exception is raised."
|
||||
[& {:keys [team-id label rollback?] :or {rollback? true}}]
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
|
||||
get-file-snapshots
|
||||
(fn [conn ids]
|
||||
(db/exec! conn [sql:snapshots-with-file label
|
||||
(db/create-array conn "uuid" ids)]))
|
||||
|
||||
restore-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [ids (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
|
||||
(into #{}))
|
||||
snap (get-file-snapshots conn ids)
|
||||
ids' (into #{} (map :file-id) snap)
|
||||
team (-> (feat.comp-v2/get-team conn team-id)
|
||||
(update :features disj "components/v2"))]
|
||||
|
||||
(when (not= ids ids')
|
||||
(throw (RuntimeException. "no uniform snapshot available")))
|
||||
|
||||
(feat.comp-v2/update-team! conn team)
|
||||
(run! (partial fsnap/restore-file-snapshot! system) snap)))]
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! restore-snapshot))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FILE VALIDATION & REPAIR
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn validate-file
|
||||
"Validate structure, referencial integrity and semantic coherence of
|
||||
all contents of a file. Returns a list of errors."
|
||||
[id]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [id (if (string? id) (parse-uuid id) id)
|
||||
file (h/get-file system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(h/get-file system id))))
|
||||
(d/index-by :id))]
|
||||
(cfv/validate-file file libs)))))
|
||||
|
||||
(defn- repair-file*
|
||||
"Internal helper for validate and repair the file. The operation is
|
||||
applied multiple times untile file is fixed or max iteration counter
|
||||
is reached (default 10)"
|
||||
[system id & {:keys [max-iterations label] :or {max-iterations 10}}]
|
||||
(let [id (parse-uuid id)
|
||||
|
||||
validate-and-repair
|
||||
(fn [file libs iteration]
|
||||
(when-let [errors (not-empty (cfv/validate-file file libs))]
|
||||
(l/trc :hint "repairing file"
|
||||
:file-id (str id)
|
||||
:iteration iteration
|
||||
:errors (count errors))
|
||||
(let [changes (cfr/repair-file file libs errors)]
|
||||
(-> file
|
||||
(update :revn inc)
|
||||
(update :data cpc/process-changes changes)))))
|
||||
|
||||
process-file
|
||||
(fn [file libs]
|
||||
(loop [file file
|
||||
iteration 0]
|
||||
(if (< iteration max-iterations)
|
||||
(if-let [file (validate-and-repair file libs iteration)]
|
||||
(recur file (inc iteration))
|
||||
file)
|
||||
(do
|
||||
(l/wrn :hint "max retry num reached on repairing file"
|
||||
:file-id (str id)
|
||||
:iteration iteration)
|
||||
file))))]
|
||||
|
||||
(db/tx-run! system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(when (string? label)
|
||||
(fsnap/take-file-snapshot! system {:file-id id :label label}))
|
||||
|
||||
(let [file (h/get-file system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(h/get-file system id))))
|
||||
(d/index-by :id))
|
||||
file (process-file file libs)]
|
||||
(h/update-file! system file))))))
|
||||
|
||||
(defn repair-file!
|
||||
"Repair the list of errors detected by validation."
|
||||
[file-id & {:keys [rollback?] :or {rollback? true} :as opts}]
|
||||
(let [system (assoc main/system ::db/rollback rollback?)]
|
||||
(repair-file* system file-id (dissoc opts :rollback?))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MISC
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn instrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(let [mf (meta f)]
|
||||
(if (::original mf)
|
||||
f
|
||||
(with-meta
|
||||
(fn [& params]
|
||||
(tap> params)
|
||||
(let [result (apply f params)]
|
||||
(tap> result)
|
||||
result))
|
||||
{::original f}))))))
|
||||
|
||||
(defn uninstrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(or (::original (meta f)) f))))
|
||||
|
||||
|
||||
(defn duplicate-team
|
||||
[team-id & {:keys [name]}]
|
||||
(let [team-id (if (string? team-id) (parse-uuid team-id) team-id)]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
||||
|
|
@ -346,4 +497,3 @@
|
|||
(assoc :team-id (:id team)))]
|
||||
(db/insert! conn :team-profile-rel params
|
||||
{::db/return-keys false}))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
[app.util.time :as dt]
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.csp :as sp]
|
||||
[promesa.util :as pu]
|
||||
[ring.request :as rreq]
|
||||
[ring.websocket :as rws]
|
||||
[yetti.websocket :as yws])
|
||||
|
|
@ -185,17 +186,18 @@
|
|||
(rws/send channel message)
|
||||
(recur i))))))
|
||||
|
||||
(catch java.nio.channels.ClosedChannelException _)
|
||||
(catch java.net.SocketException _)
|
||||
(catch java.io.IOException _)
|
||||
|
||||
(catch InterruptedException _cause
|
||||
(l/dbg :hint "websocket thread interrumpted" :conn-id id))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/err :hint "unhandled exception on websocket thread"
|
||||
:conn-id id
|
||||
:cause cause))
|
||||
(let [cause (pu/unwrap-exception cause)]
|
||||
(if (or (instance? java.nio.channels.ClosedChannelException cause)
|
||||
(instance? java.net.SocketException cause)
|
||||
(instance? java.io.IOException cause))
|
||||
nil
|
||||
(l/err :hint "unhandled exception on websocket thread"
|
||||
:conn-id id
|
||||
:cause cause))))
|
||||
(finally
|
||||
(try
|
||||
(handler wsp {:type :close})
|
||||
|
|
|
|||
|
|
@ -148,6 +148,15 @@
|
|||
[objects id]
|
||||
(mapv (d/getf objects) (get-children-ids-with-self objects id)))
|
||||
|
||||
(defn get-child
|
||||
"Return the child of the given object with the given id (allow that the
|
||||
id may point to the object itself)."
|
||||
[objects id child-id]
|
||||
(let [shape (get objects id)]
|
||||
(if (= id child-id)
|
||||
shape
|
||||
(some #(get-child objects % child-id) (:shapes shape)))))
|
||||
|
||||
(defn get-parent
|
||||
"Retrieve the parent for the shape-id (if exists)"
|
||||
[objects id]
|
||||
|
|
|
|||
|
|
@ -269,16 +269,34 @@
|
|||
|
||||
(defmethod repair-error :ref-shape-not-found
|
||||
[_ {:keys [shape page-id] :as error} file-data libraries]
|
||||
(let [matching-shape (let [page (ctpl/get-page file-data page-id)
|
||||
root-shape (ctn/get-component-shape (:objects page) shape)
|
||||
component-file (if (= (:component-file root-shape) (:id file-data))
|
||||
file-data
|
||||
(-> (get libraries (:component-file root-shape)) :data))
|
||||
component (when component-file
|
||||
(ctkl/get-component (:data component-file) (:component-id root-shape) true))
|
||||
shapes (ctf/get-component-shapes file-data component)]
|
||||
(d/seek #(= (:shape-ref %) (:shape-ref shape)) shapes))
|
||||
(let [matching-shape (let [page (ctpl/get-page file-data page-id)
|
||||
root-shape (ctn/get-component-shape (:objects page) shape)
|
||||
component-file (if (= (:component-file root-shape) (:id file-data))
|
||||
file-data
|
||||
(-> (get libraries (:component-file root-shape)) :data))
|
||||
component (when component-file
|
||||
(ctkl/get-component component-file (:component-id root-shape) true))
|
||||
component-shapes (ctf/get-component-shapes file-data component)]
|
||||
|
||||
;; Check if the shape points to the remote main. If so, reassign to the near main.
|
||||
(if-let [near-shape-1 (d/seek #(= (:shape-ref %) (:shape-ref shape)) component-shapes)]
|
||||
near-shape-1
|
||||
;; Check if it points to any random shape in the page. If so, try to find a matchng
|
||||
;; shape in the near main component.
|
||||
(when-let [random-shape (ctn/get-shape page (:shape-ref shape))]
|
||||
(if-let [near-shape-2 (d/seek #(= (:id %) (:shape-ref random-shape)) component-shapes)]
|
||||
near-shape-2
|
||||
;; If not, check if it's a fostered copy and find a direct main.
|
||||
(let [head-shape (ctn/get-head-shape (:objects page) shape)
|
||||
component-file (if (= (:component-file head-shape) (:id file-data))
|
||||
file-data
|
||||
(-> (get libraries (:component-file head-shape)) :data))
|
||||
component (when component-file
|
||||
(ctkl/get-component component-file (:component-id head-shape) true))
|
||||
component-shapes (ctf/get-component-shapes file-data component)]
|
||||
(if-let [near-shape-3 (d/seek #(= (:id %) (:shape-ref random-shape)) component-shapes)]
|
||||
near-shape-3
|
||||
nil))))))
|
||||
reassign-shape
|
||||
(fn [shape]
|
||||
(log/debug :hint " -> reassign shape-ref to" :shape-ref (:id matching-shape))
|
||||
|
|
|
|||
|
|
@ -168,7 +168,9 @@
|
|||
(if (and components-v2 (not (:deleted component)))
|
||||
(let [component-page (get-component-page file-data component)]
|
||||
(when component-page
|
||||
(ctn/get-shape component-page shape-id)))
|
||||
(cfh/get-child (:objects component-page)
|
||||
(:main-instance-id component)
|
||||
shape-id)))
|
||||
(dm/get-in component [:objects shape-id]))))
|
||||
|
||||
(defn get-ref-shape
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue