penpot/backend/src/app/srepl/main.clj

;; 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 INC

(ns app.srepl.main
  #_:clj-kondo/ignore
  (:require
   [app.auth :refer [derive-password]]
   [app.binfile.common :as bfc]
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.exceptions :as ex]
   [app.common.features :as cfeat]
   [app.common.files.validate :as cfv]
   [app.common.logging :as l]
   [app.common.pprint :as pp]
   [app.common.schema :as sm]
   [app.common.spec :as us]
   [app.common.time :as ct]
   [app.common.uuid :as uuid]
   [app.config :as cf]
   [app.db :as db]
   [app.db.sql :as-alias sql]
   [app.features.fdata :as fdata]
   [app.features.file-snapshots :as fsnap]
   [app.http.session :as session]
   [app.loggers.audit :as audit]
   [app.main :as main]
   [app.msgbus :as mbus]
   [app.rpc.commands.auth :as auth]
   [app.rpc.commands.files :as files]
   [app.rpc.commands.management :as mgmt]
   [app.rpc.commands.profile :as profile]
   [app.rpc.commands.projects :as projects]
   [app.rpc.commands.teams :as teams]
   [app.srepl.helpers :as h]
   [app.srepl.procs.file-repair :as procs.file-repair]
   [app.util.blob :as blob]
   [app.util.pointer-map :as pmap]
   [app.worker :as wrk]
   [clojure.datafy :refer [datafy]]
   [clojure.java.io :as io]
   [clojure.pprint :refer [print-table]]
   [clojure.stacktrace :as strace]
   [clojure.tools.namespace.repl :as repl]
   [cuerdas.core :as str]
   [datoteka.fs :as fs]
   [promesa.exec :as px]
   [promesa.exec.csp :as sp]
   [promesa.exec.semaphore :as ps]
   [promesa.util :as pu]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASKS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn print-tasks
  []
  (let [tasks (:app.worker/registry main/system)]
    (pp/pprint (keys tasks) :level 200)))

(defn run-task!
  ([tname]
   (run-task! tname {}))
  ([tname params]
   (wrk/invoke! (-> main/system
                    (assoc ::wrk/task tname)
                    (assoc ::wrk/params params)))))

(defn schedule-task!
  ([name]
   (schedule-task! name {}))
  ([name params]
   (wrk/submit! (-> main/system
                    (assoc ::wrk/task name)
                    (assoc ::wrk/params params)))))

(defn send-test-email!
  [destination]
  (assert (string? destination) "destination should be provided")
  (-> main/system
      (assoc ::wrk/task :sendmail)
      (assoc ::wrk/params {:body "test email"
                           :subject "test email"
                           :to [destination]})
      (wrk/invoke!)))

(defn resend-email-verification-email!
  [email]
  (db/tx-run! main/system
              (fn [{:keys [::db/conn] :as cfg}]
                (let [email   (profile/clean-email email)
                      profile (profile/get-profile-by-email conn email)]
                  (#'auth/send-email-verification! cfg profile)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROFILES MANAGEMENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn mark-profile-as-active!
  "Mark the profile blocked and removes all the http sessiones
  associated with the profile-id."
  [email]
  (some-> main/system
          (db/tx-run!
           (fn [{:keys [::db/conn] :as system}]
             (when-let [profile (db/get* conn :profile
                                         {:email (str/lower email)}
                                         {:columns [:id :email]})]
               (when-not (:is-blocked profile)
                 (db/update! conn :profile {:is-active true} {:id (:id profile)})
                 :activated))))))

(defn mark-profile-as-blocked!
  "Mark the profile blocked and removes all the http sessiones
  associated with the profile-id."
  [email]
  (some-> main/system
          (db/tx-run!
           (fn [{:keys [::db/conn] :as system}]
             (when-let [profile (db/get* conn :profile
                                         {:email (str/lower email)}
                                         {:columns [:id :email]})]
               (when-not (:is-blocked profile)
                 (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
                 (db/delete! conn :http-session {:profile-id (:id profile)})
                 :blocked))))))

(defn reset-password!
  "Reset a password to a specific one for a concrete user or all users
  if email is `:all` keyword."
  [& {:keys [email password]}]
  (assert (string? email) "expected email")
  (assert (string? password) "expected password")

  (some-> main/system
          (db/tx-run!
           (fn [{:keys [::db/conn] :as system}]
             (let [password (derive-password password)
                   email    (str/lower email)]
               (-> (db/exec-one! conn ["update profile set password=? where email=?" password email])
                   (db/get-update-count)
                   (pos?)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FEATURES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn enable-team-feature!
  [team-id feature & {:keys [skip-check] :or {skip-check false}}]
  (when (and (not skip-check) (not (contains? cfeat/supported-features feature)))
    (ex/raise :type :assertion
              :code :feature-not-supported
              :hint (str "feature '" feature "' not supported")))

  (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})
                                     (update :features db/decode-pgarray #{}))
                        features (conj (:features team) feature)]
                    (when (not= features (:features team))
                      (db/update! conn :team
                                  {:features (db/create-array conn "text" features)}
                                  {:id team-id})
                      :enabled))))))

(defn disable-team-feature!
  [team-id feature & {:keys [skip-check] :or {skip-check false}}]
  (when (and (not skip-check) (not (contains? cfeat/supported-features feature)))
    (ex/raise :type :assertion
              :code :feature-not-supported
              :hint (str "feature '" feature "' not supported")))

  (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})
                                     (update :features db/decode-pgarray #{}))
                        features (disj (:features team) feature)]
                    (when (not= features (:features team))
                      (db/update! conn :team
                                  {:features (db/create-array conn "text" features)}
                                  {:id team-id})
                      :disabled))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NOTIFICATIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn notify!
  "Send flash notifications.

  This method allows send flash notifications to specified target destinations.
  The message can be a free text or a preconfigured one.

  The destination can be: all, profile-id, team-id, or a coll of them.
  It also can be:

  {:email \"some@example.com\"}
  [[:email \"some@example.com\"], ...]

  Command examples:

  (notify! :dest :all :code :maintenance)
  (notify! :dest :all :code :upgrade-version)
  "
  [& {:keys [dest code message level]
      :or {code :generic level :info}
      :as params}]

  (when-not (contains? #{:success :error :info :warning} level)
    (ex/raise :type :assertion
              :code :incorrect-level
              :hint (str "level '" level "' not supported")))

  (let [{:keys [::mbus/msgbus ::db/pool]} main/system

        send
        (fn [dest]
          (l/inf :hint "sending notification" :dest (str dest))
          (let [message {:type :notification
                         :code code
                         :level level
                         :version (:full cf/version)
                         :subs-id dest
                         :message message}
                message (->> (dissoc params :dest :code :message :level)
                             (merge message))]
            (mbus/pub! msgbus
                       :topic dest
                       :message message)))

        resolve-profile
        (fn [email]
          (some-> (db/get* pool :profile {:email (str/lower email)} {:columns [:id]}) :id vector))

        resolve-team
        (fn [team-id]
          (->> (db/query pool :team-profile-rel
                         {:team-id team-id}
                         {:columns [:profile-id]})
               (map :profile-id)))

        resolve-dest
        (fn resolve-dest [dest]
          (cond
            (= :all dest)
            [uuid/zero]

            (uuid? dest)
            [dest]

            (string? dest)
            (some-> dest h/parse-uuid resolve-dest)

            (nil? dest)
            [uuid/zero]

            (map? dest)
            (sequence (comp
                       (map vec)
                       (mapcat resolve-dest))
                      dest)

            (and (vector? dest)
                 (every? vector? dest))
            (sequence (comp
                       (map vec)
                       (mapcat resolve-dest))
                      dest)

            (and (vector? dest)
                 (keyword? (first dest)))
            (let [[op param] dest]
              (cond
                (= op :email)
                (cond
                  (and (coll? param)
                       (every? string? param))
                  (sequence (comp
                             (keep resolve-profile)
                             (mapcat identity))
                            param)

                  (string? param)
                  (resolve-profile param))

                (= op :team-id)
                (cond
                  (coll? param)
                  (sequence (comp
                             (mapcat resolve-team)
                             (keep h/parse-uuid))
                            param)

                  (uuid? param)
                  (resolve-team param)

                  (string? param)
                  (some-> param h/parse-uuid resolve-team))

                (= op :profile-id)
                (if (coll? param)
                  (sequence (keep h/parse-uuid) param)
                  (resolve-dest param))))))]

    (->> (resolve-dest dest)
         (filter some?)
         (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
                (fn [cfg]
                  (let [file (bfc/get-file cfg file-id :realize? true)]
                    (fsnap/create! cfg file {:label label :created-by "admin"}))))))

(defn restore-file-snapshot!
  [file-id & {:keys [label id]}]
  (let [file-id     (h/parse-uuid file-id)
        snapshot-id (some-> id h/parse-uuid)]
    (db/tx-run! main/system
                (fn [{:keys [::db/conn] :as system}]
                  (cond
                    (uuid? snapshot-id)
                    (fsnap/restore! system file-id snapshot-id)

                    (string? label)
                    (->> (h/search-file-snapshots conn #{file-id} label)
                         (map :id)
                         (first)
                         (fsnap/restore! system file-id))

                    :else
                    (throw (ex-info "snapshot id or label should be provided" {})))))))

(defn list-file-snapshots!
  [file-id & {:as _}]
  (let [file-id (h/parse-uuid file-id)]
    (db/tx-run! main/system
                (fn [cfg]
                  (->> (fsnap/get-visible-snapshots cfg file-id)
                       (print-table [:label :id :revn :created-at :created-by]))))))

(defn take-team-snapshot!
  [team-id & {:keys [label rollback?] :or {rollback? true}}]
  (let [team-id (h/parse-uuid team-id)]
    (-> (assoc main/system ::db/rollback rollback?)
        (db/tx-run! h/take-team-snapshot! team-id label))))

(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."
  [team-id label & {:keys [rollback?] :or {rollback? true}}]
  (let [team-id (h/parse-uuid team-id)]
    (-> (assoc main/system ::db/rollback rollback?)
        (db/tx-run! h/restore-team-snapshot! team-id label))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE VALIDATION & REPAIR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn validate-file
  "Validate structure, referencial integrity and semantic coherence of
  all contents of a file. Returns a list of errors."
  [file-id]
  (let [file-id (h/parse-uuid file-id)]
    (db/tx-run! (assoc main/system ::db/rollback true)
                (fn [system]
                  (let [file (bfc/get-file system file-id)
                        libs (bfc/get-resolved-file-libraries system file)]
                    (cfv/validate-file file libs))))))

(defn validate-file-schema
  "Validate structure, referencial integrity and semantic coherence of
  all contents of a file. Returns a list of errors."
  [file-id]
  (let [file-id (h/parse-uuid file-id)]
    (db/tx-run! (assoc main/system ::db/rollback true)
                (fn [system]
                  (try
                    (let [file (bfc/get-file system file-id)]
                      (cfv/validate-file-schema! file)
                      (println "OK"))
                    (catch Exception cause
                      (if-let [explain (-> cause ex-data ::sm/explain)]
                        (println (sm/humanize-explain explain))
                        (ex/print-throwable cause))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROCESSING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn repair-file!
  "Repair the list of errors detected by validation."
  [file-id & {:keys [rollback?] :or {rollback? true} :as options}]
  (let [system  (assoc main/system ::db/rollback rollback?)
        file-id (h/parse-uuid file-id)
        options (assoc options ::h/with-libraries? true)]
    (db/tx-run! system h/process-file! file-id procs.file-repair/repair-file options)))

(defn update-file!
  "Apply a function to the file. Optionally save the changes or not.
  The function receives the decoded and migrated file data."
  [file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
  (let [file-id (h/parse-uuid file-id)]
    (db/tx-run! (assoc main/system ::db/rollback rollback?)
                (fn [system]
                  (binding [h/*system* system
                            db/*conn* (db/get-connection system)]
                    (h/process-file! system file-id update-fn opts))))))

(defn process!
  [& {:keys [max-items
             max-jobs
             rollback?
             query
             proc-fn
             buffer]
      :or {max-items Long/MAX_VALUE
           rollback? true
           max-jobs 1
           buffer 128}
      :as opts}]

  (l/inf :hint "process start"
         :rollback rollback?
         :max-jobs max-jobs
         :max-items max-items)

  (let [tpoint    (ct/tpoint)
        max-jobs  (or max-jobs (px/get-available-processors))
        query     (or query
                      (:query (meta proc-fn))
                      (throw (ex-info "missing query" {})))
        query     (if (vector? query) query [query])

        proc-fn   (if (var? proc-fn)
                    (deref proc-fn)
                    proc-fn)

        in-ch     (sp/chan :buf buffer)

        worker-fn
        (fn [worker-id]
          (l/dbg :hint "worker started"
                 :id worker-id)

          (loop []
            (when-let [[index item] (sp/<! in-ch)]
              (l/dbg :hint "process item" :worker-id worker-id :index index :item item)
              (try
                (-> main/system
                    (assoc ::db/rollback rollback?)
                    (db/tx-run! (fn [system]
                                  (binding [h/*system* system
                                            db/*conn* (db/get-connection system)]
                                    (proc-fn system item opts)))))

                (catch Throwable cause
                  (l/wrn :hint "unexpected error on processing item (skiping)"
                         :worker-id worker-id
                         :item item
                         :cause cause))
                (finally
                  (when-let [pause (:pause opts)]
                    (Thread/sleep (int pause)))))

              (recur)))

          (l/dbg :hint "worker stoped"
                 :id worker-id))

        enqueue-item
        (fn [index row]
          (sp/>! in-ch [index (into {} row)])
          (inc index))

        process-items
        (fn [{:keys [::db/conn] :as system}]
          (db/exec! conn ["SET statement_timeout = 0"])
          (db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])

          (->> (db/plan conn query {:fetch-size (* max-jobs 3)})
               (transduce (take max-items)
                          (completing enqueue-item)
                          0))
          (sp/close! in-ch))

        threads
        (->> (range max-jobs)
             (map (fn [idx]
                    (px/fn->thread (partial worker-fn idx)
                                   :name (str "pentpot/process/" idx))))
             (doall))]

    (try
      (db/tx-run! main/system process-items)

      ;; Await threads termination
      (doseq [thread threads]
        (px/await! thread))

      (catch Throwable cause
        (l/dbg :hint "process:error" :cause cause))

      (finally
        (let [elapsed (ct/format-duration (tpoint))]
          (l/inf :hint "process end"
                 :rollback rollback?
                 :elapsed elapsed))))))


(defn process-file!
  "A specialized, file specific process! alternative"
  [& {:keys [id] :as opts}]
  (let [id (h/parse-uuid id)]
    (-> opts
        (assoc :query ["select id from file where id = ?" id])
        (assoc :max-items 1)
        (assoc :max-jobs 1)
        (process!))))

(defn mark-file-as-trimmed
  [id]
  (let [id (h/parse-uuid id)]
    (db/tx-run! main/system (fn [cfg]
                              (-> (db/update! cfg :file
                                              {:has-media-trimmed true}
                                              {:id id}
                                              {::db/return-keys false})
                                  (db/get-update-count)
                                  (pos?))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn delete-file!
  "Mark a project for deletion"
  [file-id]
  (let [file-id (h/parse-uuid file-id)
        tnow    (ct/now)]

    (audit/insert! main/system
                   {::audit/name "delete-file"
                    ::audit/type "action"
                    ::audit/profile-id uuid/zero
                    ::audit/props {:id file-id}
                    ::audit/context {:triggered-by "srepl"
                                     :cause "explicit call to delete-file!"}
                    ::audit/tracked-at tnow})
    (wrk/invoke! (-> main/system
                     (assoc ::wrk/task :delete-object)
                     (assoc ::wrk/params {:object :file
                                          :deleted-at tnow
                                          :id file-id})))
    :deleted))

(defn restore-file!
  "Mark a file and all related objects as not deleted"
  [file-id]
  (let [file-id (h/parse-uuid file-id)]
    (db/tx-run! main/system
                (fn [{:keys [::db/conn] :as system}]
                  (when-let [file (db/get* system :file
                                           {:id file-id}
                                           {::db/remove-deleted false
                                            ::sql/columns [:id :name]})]
                    (audit/insert! system
                                   {::audit/name "restore-file"
                                    ::audit/type "action"
                                    ::audit/profile-id uuid/zero
                                    ::audit/props file
                                    ::audit/context {:triggered-by "srepl"
                                                     :cause "explicit call to restore-file!"}
                                    ::audit/tracked-at (ct/now)})


                    (#'files/restore-files conn [file-id]))
                  :restored))))

(defn delete-project!
  "Mark a project for deletion"
  [project-id]
  (let [project-id (h/parse-uuid project-id)
        tnow       (ct/now)]

    (audit/insert! main/system
                   {::audit/name "delete-project"
                    ::audit/type "action"
                    ::audit/profile-id uuid/zero
                    ::audit/props {:id project-id}
                    ::audit/context {:triggered-by "srepl"
                                     :cause "explicit call to delete-project!"}
                    ::audit/tracked-at tnow})

    (wrk/invoke! (-> main/system
                     (assoc ::wrk/task :delete-object)
                     (assoc ::wrk/params {:object :project
                                          :deleted-at tnow
                                          :id project-id})))
    :deleted))

(defn- restore-project*
  [{:keys [::db/conn] :as cfg} project-id]
  (db/update! conn :project
              {:deleted-at nil}
              {:id project-id})

  (doseq [{:keys [id]} (db/query conn :file
                                 {:project-id project-id}
                                 {::sql/columns [:id]})]
    (#'files/restore-files conn [id]))

  :restored)

(defn restore-project!
  "Mark a project and all related objects as not deleted"
  [project-id]
  (let [project-id (h/parse-uuid project-id)]
    (db/tx-run! main/system
                (fn [system]
                  (when-let [project (db/get* system :project
                                              {:id project-id}
                                              {::db/remove-deleted false})]
                    (audit/insert! system
                                   {::audit/name "restore-project"
                                    ::audit/type "action"
                                    ::audit/profile-id uuid/zero
                                    ::audit/props project
                                    ::audit/context {:triggered-by "srepl"
                                                     :cause "explicit call to restore-team!"}
                                    ::audit/tracked-at (ct/now)})

                    (restore-project* system project-id))))))

(defn delete-team!
  "Mark a team for deletion"
  [team-id]
  (let [team-id (h/parse-uuid team-id)
        tnow    (ct/now)]

    (audit/insert! main/system
                   {::audit/name "delete-team"
                    ::audit/type "action"
                    ::audit/profile-id uuid/zero
                    ::audit/props {:id team-id}
                    ::audit/context {:triggered-by "srepl"
                                     :cause "explicit call to delete-profile!"}
                    ::audit/tracked-at tnow})

    (wrk/invoke! (-> main/system
                     (assoc ::wrk/task :delete-object)
                     (assoc ::wrk/params {:object :team
                                          :deleted-at tnow
                                          :id team-id})))
    :deleted))

(defn- restore-team*
  [{:keys [::db/conn] :as cfg} team-id]
  (db/update! conn :team
              {:deleted-at nil}
              {:id team-id})

  (db/update! conn :team-font-variant
              {:deleted-at nil}
              {:team-id team-id})

  (doseq [{:keys [id]} (db/query conn :project
                                 {:team-id team-id}
                                 {::sql/columns [:id]})]
    (restore-project* cfg id))

  :restored)

(defn restore-team!
  "Mark a team and all related objects as not deleted"
  [team-id]
  (let [team-id (h/parse-uuid team-id)]
    (db/tx-run! main/system
                (fn [system]
                  (when-let [team (some-> (db/get* system :team
                                                   {:id team-id}
                                                   {::db/remove-deleted false})
                                          (teams/decode-row))]
                    (audit/insert! system
                                   {::audit/name "restore-team"
                                    ::audit/type "action"
                                    ::audit/profile-id uuid/zero
                                    ::audit/props team
                                    ::audit/context {:triggered-by "srepl"
                                                     :cause "explicit call to restore-team!"}
                                    ::audit/tracked-at (ct/now)})

                    (restore-team* system team-id))))))

(defn delete-profile!
  "Mark a profile for deletion."
  [profile-id]
  (let [profile-id (h/parse-uuid profile-id)
        tnow       (ct/now)]

    (audit/insert! main/system
                   {::audit/name "delete-profile"
                    ::audit/type "action"
                    ::audit/profile-id uuid/zero
                    ::audit/context {:triggered-by "srepl"
                                     :cause "explicit call to delete-profile!"}
                    ::audit/tracked-at tnow})

    (wrk/invoke! (-> main/system
                     (assoc ::wrk/task :delete-object)
                     (assoc ::wrk/params {:object :profile
                                          :deleted-at tnow
                                          :id profile-id})))
    :deleted))

(defn restore-profile!
  "Mark a team and all related objects as not deleted"
  [profile-id]
  (let [profile-id (h/parse-uuid profile-id)]
    (db/tx-run! main/system
                (fn [system]
                  (when-let [profile (some-> (db/get* system :profile
                                                      {:id profile-id}
                                                      {::db/remove-deleted false})
                                             (profile/decode-row))]
                    (audit/insert! system
                                   {::audit/name "restore-profile"
                                    ::audit/type "action"
                                    ::audit/profile-id uuid/zero
                                    ::audit/props (audit/profile->props profile)
                                    ::audit/context {:triggered-by "srepl"
                                                     :cause "explicit call to restore-profile!"}
                                    ::audit/tracked-at (ct/now)})

                    (db/update! system :profile
                                {:deleted-at nil}
                                {:id profile-id}
                                {::db/return-keys false})

                    (doseq [{:keys [id]} (profile/get-owned-teams system profile-id)]
                      (restore-team* system id))

                    :restored)))))

(defn delete-profiles-in-bulk!
  [system path]
  (letfn [(process-data! [system deleted-at emails]
            (loop [emails  emails
                   deleted 0
                   total   0]
              (if-let [email (first emails)]
                (if-let [profile (some-> (db/get* system :profile
                                                  {:email (str/lower email)}
                                                  {::db/remove-deleted false})
                                         (profile/decode-row))]
                  (do
                    (audit/insert! system
                                   {::audit/name "delete-profile"
                                    ::audit/type "action"
                                    ::audit/profile-id (:id profile)
                                    ::audit/tracked-at deleted-at
                                    ::audit/props (audit/profile->props profile)
                                    ::audit/context {:triggered-by "srepl"
                                                     :cause "explicit call to delete-profiles-in-bulk!"}})
                    (wrk/invoke! (-> system
                                     (assoc ::wrk/task :delete-object)
                                     (assoc ::wrk/params {:object :profile
                                                          :deleted-at deleted-at
                                                          :id (:id profile)})))
                    (recur (rest emails)
                           (inc deleted)
                           (inc total)))
                  (recur (rest emails)
                         deleted
                         (inc total)))
                {:deleted deleted :total total})))]

    (let [path       (fs/path path)
          deleted-at (ct/minus (ct/now) (cf/get-deletion-delay))]

      (when-not (fs/exists? path)
        (throw (ex-info "path does not exists" {:path path})))

      (db/tx-run! system
                  (fn [system]
                    (with-open [reader (io/reader path)]
                      (process-data! system deleted-at (line-seq reader))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CASCADE FIXING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn process-deleted-profiles-cascade
  []
  (->> (db/exec! main/system ["select id, deleted_at from profile where deleted_at is not null"])
       (run! (fn [{:keys [id deleted-at]}]
               (wrk/invoke! (-> main/system
                                (assoc ::wrk/task :delete-object)
                                (assoc ::wrk/params {:object :profile
                                                     :deleted-at deleted-at
                                                     :id id})))))))

(defn process-deleted-teams-cascade
  []
  (->> (db/exec! main/system ["select id, deleted_at from team where deleted_at is not null"])
       (run! (fn [{:keys [id deleted-at]}]
               (wrk/invoke! (-> main/system
                                (assoc ::wrk/task :delete-object)
                                (assoc ::wrk/params {:object :team
                                                     :deleted-at deleted-at
                                                     :id id})))))))

(defn process-deleted-projects-cascade
  []
  (->> (db/exec! main/system ["select id, deleted_at from project where deleted_at is not null"])
       (run! (fn [{:keys [id deleted-at]}]
               (wrk/invoke! (-> main/system
                                (assoc ::wrk/task :delete-object)
                                (assoc ::wrk/params {:object :project
                                                     :deleted-at deleted-at
                                                     :id id})))))))

(defn process-deleted-files-cascade
  []
  (->> (db/exec! main/system ["select id, deleted_at from file where deleted_at is not null"])
       (run! (fn [{:keys [id deleted-at]}]
               (wrk/invoke! (-> main/system
                                (assoc ::wrk/task :delete-object)
                                (assoc ::wrk/params {:object :file
                                                     :deleted-at deleted-at
                                                     :id id})))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SSO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn add-sso-config
  [& {:keys [base-uri client-id client-secret domain]}]

  (assert (and (string? base-uri) (str/starts-with? base-uri "http")) "expected a valid base-uri")
  (assert (string? client-id) "expected a valid client-id")
  (assert (string? client-secret) "expected a valid client-secret")
  (assert (string? domain) "expected a valid domain")
  (db/insert! main/system :sso-provider
              {:id (uuid/next)
               :type "oidc"
               :client-id client-id
               :client-secret client-secret
               :domain domain
               :base-uri base-uri}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MISC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn decode-session-token
  [token]
  (session/decode-token main/system token))

(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)]
    (db/tx-run! main/system
                (fn [{:keys [::db/conn] :as cfg}]
                  (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
                  (let [team (-> (assoc cfg ::bfc/timestamp (ct/now))
                                 (mgmt/duplicate-team :team-id team-id :name name))
                        rels (db/query conn :team-profile-rel {:team-id team-id})]

                    (doseq [rel rels]
                      (let [params (-> rel
                                       (assoc :id (uuid/next))
                                       (assoc :team-id (:id team)))]
                        (teams/add-profile-to-team! cfg params {::db/return-keys false}))))))))