diff --git a/backend/src/app/srepl/dev.clj b/backend/src/app/srepl/dev.clj deleted file mode 100644 index 61ec418f5..000000000 --- a/backend/src/app/srepl/dev.clj +++ /dev/null @@ -1,14 +0,0 @@ -(ns app.srepl.dev - #_:clj-kondo/ignore - (:require - [app.db :as db] - [app.config :as cfg] - [app.rpc.commands.auth :refer [derive-password]] - [app.main :refer [system]])) - -(defn reset-passwords - [system] - (db/with-atomic [conn (:app.db/pool system)] - (let [password (derive-password "123123")] - (db/exec! conn ["update profile set password=?" password])))) - diff --git a/backend/src/app/srepl/fixes.clj b/backend/src/app/srepl/fixes.clj new file mode 100644 index 000000000..00022a43a --- /dev/null +++ b/backend/src/app/srepl/fixes.clj @@ -0,0 +1,43 @@ +;; 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) UXBOX Labs SL + +(ns app.srepl.fixes + "A collection of adhoc fixes scripts." + (:require + [app.common.logging :as l] + [app.common.uuid :as uuid] + [app.srepl.helpers :as h])) + +(defn repair-orphaned-shapes + "There are some shapes whose parent has been deleted. This function + detects them and puts them as children of the root node." + ([data] + (letfn [(is-orphan? [shape objects] + (and (some? (:parent-id shape)) + (nil? (get objects (:parent-id shape))))) + + (update-page [page] + (let [objects (:objects page) + orphans (into #{} (filter #(is-orphan? % objects)) (vals objects))] + (if (seq orphans) + (do + (l/info :hint "found a file with orphans" :file-id (:id data) :broken-shapes (count orphans)) + (-> page + (h/update-shapes (fn [shape] + (if (contains? orphans shape) + (assoc shape :parent-id uuid/zero) + shape))) + (update-in [:objects uuid/zero :shapes] into (map :id) orphans))) + page)))] + + (h/update-pages data update-page))) + + ;; special arity for to be called from h/analyze-files to search for + ;; files with possible issues + + ([file state] + (repair-orphaned-shapes (:data file)) + (update state :total (fnil inc 0)))) diff --git a/backend/src/app/srepl/helpers.clj b/backend/src/app/srepl/helpers.clj new file mode 100644 index 000000000..1db3b5434 --- /dev/null +++ b/backend/src/app/srepl/helpers.clj @@ -0,0 +1,120 @@ +;; 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) UXBOX Labs SL + +(ns app.srepl.helpers + "A main namespace for server repl." + #_:clj-kondo/ignore + (:require + [app.common.data :as d] + [app.common.exceptions :as ex] + [app.common.logging :as l] + [app.common.pages :as cp] + [app.common.pages.migrations :as pmg] + [app.common.pprint :refer [pprint]] + [app.common.spec :as us] + [app.common.uuid :as uuid] + [app.config :as cfg] + [app.db :as db] + [app.db.sql :as sql] + [app.main :refer [system]] + [app.rpc.commands.auth :refer [derive-password]] + [app.rpc.queries.profile :as prof] + [app.util.blob :as blob] + [app.util.time :as dt] + [clojure.spec.alpha :as s] + [clojure.walk :as walk] + [cuerdas.core :as str] + [expound.alpha :as expound])) + +(defn reset-password! + "Reset a password to a specific one for a concrete user or all users + if email is `:all` keyword." + [system & {:keys [email password] :or {password "123123"} :as params}] + (us/verify! (contains? params :email) "`email` parameter is mandatory") + (db/with-atomic [conn (:app.db/pool system)] + (let [password (derive-password password)] + (if (= email :all) + (db/exec! conn ["update profile set password=?" password]) + (let [email (str/lower email)] + (db/exec! conn ["update profile set password=? where email=?" password email])))))) + +(defn reset-file-data! + "Hardcode replace of the data of one file." + [system id data] + (db/with-atomic [conn (:app.db/pool system)] + (db/update! conn :file + {:data data} + {:id id}))) + +(defn get-file + "Get the migrated data of one file." + [system id] + (-> (:app.db/pool system) + (db/get-by-id :file id) + (update :data blob/decode) + (update :data pmg/migrate-data))) + +(defn update-file! + "Apply a function to the data of one file. Optionally save the changes or not. + The function receives the decoded and migrated file data." + [system & {:keys [update-fn id save? migrate? inc-revn?] + :or {save? false migrate? true inc-revn? true}}] + (db/with-atomic [conn (:app.db/pool system)] + (let [file (db/get-by-id conn :file id {:for-update true}) + file (-> file + (update :data blob/decode) + (cond-> migrate? (update :data pmg/migrate-data)) + (update :data update-fn) + (update :data blob/encode) + (cond-> inc-revn? (update :revn inc)))] + (when save? + (db/update! conn :file + {:data (:data file) + :revn (:revn file)} + {:id (:id file)})) + (update file :data blob/decode)))) + +(def ^:private sql:retrieve-files-chunk + "SELECT id, name, modified_at, data FROM file + WHERE created_at < ? AND deleted_at is NULL + ORDER BY created_at desc LIMIT ?") + +(defn analyze-files + "Apply a function to all files in the database, reading them in + batches. Do not change data. + + The `on-file` parameter should be a function that receives the file + and the previous state and returns the new state." + [system {:keys [chunk-size on-file] :or {chunk-size 10}}] + (letfn [(get-chunk [conn cursor] + (let [rows (db/exec! conn [sql:retrieve-files-chunk cursor chunk-size])] + [(some->> rows peek :created-at) (seq rows)])) + + (get-candidates [conn] + (->> (d/iteration (partial get-chunk conn) + :vf second + :kf first + :initk (dt/now)) + (sequence cat) + (map #(update % :data blob/decode))))] + + (db/with-atomic [conn (:app.db/pool system)] + (loop [state {} + files (get-candidates conn)] + (if-let [file (first files)] + (let [state (on-file file state)] + (recur state (rest files))) + state))))) + +(defn update-pages + "Apply a function to all pages of one file. The function receives a page and returns an updated page." + [data f] + (update data :pages-index d/update-vals f)) + +(defn update-shapes + "Apply a function to all shapes of one page The function receives a shape and returns an updated shape" + [page f] + (update page :objects d/update-vals f)) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 47245e57f..ef3dd336c 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -1,203 +1,15 @@ +;; 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) UXBOX Labs SL + (ns app.srepl.main - "A main namespace for server repl." + "A collection of adhoc fixes scripts." #_:clj-kondo/ignore (:require - [app.common.data :as d] - [app.common.exceptions :as ex] [app.common.logging :as l] - [app.common.pages :as cp] - [app.common.pages.migrations :as pmg] - [app.common.uuid :as uuid] - [app.config :as cfg] - [app.db :as db] - [app.db.sql :as sql] - [app.main :refer [system]] - [app.rpc.queries.profile :as prof] - [app.srepl.dev :as dev] - [app.util.blob :as blob] - [app.util.time :as dt] - [clojure.spec.alpha :as s] - [clojure.walk :as walk] - [cuerdas.core :as str] - [expound.alpha :as expound] - [fipp.edn :refer [pprint]])) - -;; ==== Utility functions - -(defn reset-file-data - "Hardcode replace of the data of one file." - [system id data] - (db/with-atomic [conn (:app.db/pool system)] - (db/update! conn :file - {:data data} - {:id id}))) - -(defn get-file - "Get the migrated data of one file." - [system id] - (-> (:app.db/pool system) - (db/get-by-id :file id) - (update :data app.util.blob/decode) - (update :data pmg/migrate-data))) - -(defn duplicate-file - "This is a raw version of duplication of file just only for forensic analysis." - [system file-id email] - (db/with-atomic [conn (:app.db/pool system)] - (when-let [profile (some->> (prof/retrieve-profile-data-by-email conn (str/lower email)) - (prof/populate-additional-data conn))] - (when-let [file (db/exec-one! conn (sql/select :file {:id file-id}))] - (let [params (assoc file - :id (uuid/next) - :project-id (:default-project-id profile))] - (db/insert! conn :file params) - (:id file)))))) - -(defn update-file - "Apply a function to the data of one file. Optionally save the changes or not. - - The function receives the decoded and migrated file data." - ([system id f] (update-file system id f false)) - ([system id f save?] - (db/with-atomic [conn (:app.db/pool system)] - (let [file (db/get-by-id conn :file id {:for-update true}) - file (-> file - (update :data app.util.blob/decode) - (update :data pmg/migrate-data) - (update :data f) - (update :data blob/encode) - (update :revn inc))] - (when save? - (db/update! conn :file - {:data (:data file)} - {:id (:id file)})) - (update file :data blob/decode))))) - -(defn analyze-files - "Apply a function to all files in the database, reading them in batches. Do not change data. - - The function receives an object with some properties of the file and the decoded data, and - an empty atom where it may accumulate statistics, if desired." - [system {:keys [sleep chunk-size max-chunks on-file] - :or {sleep 1000 chunk-size 10 max-chunks ##Inf}}] - (let [stats (atom {})] - (letfn [(retrieve-chunk [conn cursor] - (let [sql (str "select id, name, modified_at, data from file " - " where modified_at < ? and deleted_at is null " - " order by modified_at desc limit ?")] - (->> (db/exec! conn [sql cursor chunk-size]) - (map #(update % :data blob/decode))))) - - (process-chunk [chunk] - (loop [files chunk] - (when-let [file (first files)] - (on-file file stats) - (recur (rest files)))))] - - (db/with-atomic [conn (:app.db/pool system)] - (loop [cursor (dt/now) - chunks 0] - (when (< chunks max-chunks) - (let [chunk (retrieve-chunk conn cursor)] - (when-not (empty? chunk) - (let [cursor (-> chunk last :modified-at)] - (process-chunk chunk) - (Thread/sleep (inst-ms (dt/duration sleep))) - (recur cursor (inc chunks))))))) - @stats)))) - -(defn update-pages - "Apply a function to all pages of one file. The function receives a page and returns an updated page." - [data f] - (update data :pages-index d/update-vals f)) - -(defn update-shapes - "Apply a function to all shapes of one page The function receives a shape and returns an updated shape" - [page f] - (update page :objects d/update-vals f)) - - -;; ==== Specific fixes - -(defn repair-orphaned-shapes - "There are some shapes whose parent has been deleted. This - function detects them and puts them as children of the root node." - ([file _] ; to be called from analyze-files to search for files with the problem - (repair-orphaned-shapes (:data file))) - - ([data] - (let [is-orphan? (fn [shape objects] - (and (some? (:parent-id shape)) - (nil? (get objects (:parent-id shape))))) - - update-page (fn [page] - (let [objects (:objects page) - orphans (set (filter #(is-orphan? % objects) (vals objects)))] - (if (seq orphans) - (do - (prn (:id data) "file has" (count orphans) "broken shapes") - (-> page - (update-shapes (fn [shape] - (if (orphans shape) - (assoc shape :parent-id uuid/zero) - shape))) - (update-in [:objects uuid/zero :shapes] - (fn [shapes] (into shapes (map :id orphans)))))) - page)))] - - (update-pages data update-page)))) - - -;; DO NOT DELETE already used scripts, could be taken as templates for easyly writing new ones -;; ------------------------------------------------------------------------------------------- - -;; (defn repair-orphaned-components -;; "We have detected some cases of component instances that are not nested, but -;; however they have not the :component-root? attribute (so the system considers -;; them nested). This script fixes this adding them the attribute. -;; -;; Use it with the update-file function above." -;; [data] -;; (let [update-page -;; (fn [page] -;; (prn "================= Page:" (:name page)) -;; (letfn [(is-nested? [object] -;; (and (some? (:component-id object)) -;; (nil? (:component-root? object)))) -;; -;; (is-instance? [object] -;; (some? (:shape-ref object))) -;; -;; (get-parent [object] -;; (get (:objects page) (:parent-id object))) -;; -;; (update-object [object] -;; (if (and (is-nested? object) -;; (not (is-instance? (get-parent object)))) -;; (do -;; (prn "Orphan:" (:name object)) -;; (assoc object :component-root? true)) -;; object))] -;; -;; (update page :objects d/update-vals update-object)))] -;; -;; (update data :pages-index d/update-vals update-page))) - -;; (defn check-image-shapes -;; [{:keys [data] :as file} stats] -;; (println "=> analizing file:" (:name file) (:id file)) -;; (swap! stats update :total-files (fnil inc 0)) -;; (let [affected? (atom false)] -;; (walk/prewalk (fn [obj] -;; (when (and (map? obj) (= :image (:type obj))) -;; (when-let [fcolor (some-> obj :fill-color str/upper)] -;; (when (or (= fcolor "#B1B2B5") -;; (= fcolor "#7B7D85")) -;; (reset! affected? true) -;; (swap! stats update :affected-shapes (fnil inc 0)) -;; (println "--> image shape:" ((juxt :id :name :fill-color :fill-opacity) obj))))) -;; obj) -;; data) -;; (when @affected? -;; (swap! stats update :affected-files (fnil inc 0))))) + [app.srepl.helpers :as h] + [app.srepl.fixes :as f])) +;; Empty namespace as main entry point for Server REPL