From 6d35cb2eb48bcd813d0ecd8b008c5bd7452e56eb Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 8 Feb 2024 15:21:31 +0100 Subject: [PATCH] :sparkles: Improve snapshot related internal API This commit also adds the ability to take snapshot of all files of the team in a single run/transaction. --- backend/src/app/features/components_v2.clj | 14 +- backend/src/app/http/debug.clj | 12 +- backend/src/app/rpc/commands/files.clj | 5 +- .../src/app/rpc/commands/files_snapshot.clj | 151 ++++++--- backend/src/app/srepl/components_v2.clj | 40 --- backend/src/app/srepl/helpers.clj | 290 ++++++++++-------- backend/src/app/srepl/main.clj | 207 +++++++++---- 7 files changed, 433 insertions(+), 286 deletions(-) diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index 16affe6c9f..491a493571 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -1497,7 +1497,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] @@ -1546,19 +1546,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 @@ -1657,7 +1659,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))))))] diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index 569e6d09df..a50c7fc14f 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -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"})) diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index f2e6a19899..3f73132915 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -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]}] diff --git a/backend/src/app/rpc/commands/files_snapshot.clj b/backend/src/app/rpc/commands/files_snapshot.clj index 0e902047c0..e70e3cf239 100644 --- a/backend/src/app/rpc/commands/files_snapshot.clj +++ b/backend/src/app/rpc/commands/files_snapshot.clj @@ -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))))) diff --git a/backend/src/app/srepl/components_v2.clj b/backend/src/app/srepl/components_v2.clj index 63a63efed8..1c14e15d5c 100644 --- a/backend/src/app/srepl/components_v2.clj +++ b/backend/src/app/srepl/components_v2.clj @@ -12,7 +12,6 @@ [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] @@ -634,42 +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 (h/parse-uuid 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)))) diff --git a/backend/src/app/srepl/helpers.clj b/backend/src/app/srepl/helpers.clj index fe39a9bc5a..063f379d21 100644 --- a/backend/src/app/srepl/helpers.clj +++ b/backend/src/app/srepl/helpers.clj @@ -56,6 +56,75 @@ (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." [id data] @@ -65,111 +134,90 @@ {: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 get-file - "Get the migrated data of one file." - [id] - (get-file* main/system id)) - -(defn validate +(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 (get-file* system id) + file (get-file system id) libs (->> (files/get-file-libraries conn id) (into [file] (map (fn [{:keys [id]}] - (get-file* system id)))) + (get-file system id)))) (d/index-by :id))] (validate/validate-file file libs))))) -(defn repair! +(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] :or {max-iterations 10}}] + (let [id (parse-uuid id) + + validate-and-repair + (fn [file libs iteration] + (when-let [errors (not-empty (validate/validate-file file libs))] + (l/trc :hint "repairing file" + :file-id (str id) + :iteration iteration + :errors (count errors)) + (let [changes (repair/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) + (do + (l/wrn :hint "max retry num reached on repairing file" + :file-id (str id) + :iteration iteration) + file) + (if-let [file (validate-and-repair file libs iteration)] + (recur file (inc iteration)) + file))))] + + (db/tx-run! system + (fn [{:keys [::db/conn] :as system}] + (let [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)) + file (process-file file libs)] + (update-file! system file)))))) + +(defn repair-file! "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) + [id & {:keys [rollback?] :or {rollback? true} :as opts}] + (let [system (or *system* (assoc main/system ::db/rollback rollback?))] + (repair-file* system id (dissoc opts :rollback?)))) - file (-> file - (update :revn inc) - (update :data cpc/process-changes changes)) +(defn process-file* + [system file-id update-fn] + (let [file (get-file system file-id) + file (-> (update-fn file) + (update :revn inc))] - file (if (contains? (:features file) "fdata/objects-map") - (feat.fdata/enable-objects-map file) - file) + (cfv/validate-file-schema! file) + (update-file! system file) + (dissoc file :data))) - 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 +244,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 +268,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 +297,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 +366,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)))))))) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 2dfb8244e9..2fd57b2003 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -19,7 +19,8 @@ [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] @@ -38,7 +39,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 +89,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 +130,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] @@ -171,57 +189,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] @@ -321,6 +292,121 @@ (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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 (h/parse-uuid team-id)] @@ -337,4 +423,3 @@ (assoc :team-id (:id team)))] (db/insert! conn :team-profile-rel params {::db/return-keys false})))))))) -