penpot/backend/src/app/features/fdata.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.features.fdata
  "A `fdata/*` related feature migration helpers"
  (:require
   [app.common.data :as d]
   [app.common.exceptions :as ex]
   [app.common.files.helpers :as cfh]
   [app.common.files.migrations :as fmg]
   [app.common.logging :as l]
   [app.common.types.objects-map :as omap]
   [app.common.types.path :as path]
   [app.db :as db]
   [app.db.sql :as-alias sql]
   [app.storage :as sto]
   [app.util.blob :as blob]
   [app.util.objects-map :as omap.legacy]
   [app.util.pointer-map :as pmap]
   [app.worker :as wrk]
   [promesa.exec :as px]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OFFLOAD
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn offloaded?
  [file]
  (= "objects-storage" (:data-backend file)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OBJECTS-MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn enable-objects-map
  [file & _opts]
  (let [update-page
        (fn [page]
          (update page :objects omap/wrap))

        update-data
        (fn [fdata]
          (update fdata :pages-index d/update-vals update-page))]

    (-> file
        (update :data update-data)
        (update :features conj "fdata/objects-map"))))

(defn disable-objects-map
  [file & _opts]
  (let [update-page
        (fn [page]
          (update page :objects #(into {} %)))

        update-data
        (fn [fdata]
          (update fdata :pages-index d/update-vals update-page))]

    (-> file
        (update :data update-data)
        (update :features disj "fdata/objects-map"))))

(defn process-objects
  "Apply a function to all objects-map on the file. Usualy used for convert
  the objects-map instances to plain maps"
  [fdata update-fn]
  (if (contains? fdata :pages-index)
    (update fdata :pages-index d/update-vals
            (fn [page]
              (update page :objects
                      (fn [objects]
                        (if (or (omap/objects-map? objects)
                                (omap.legacy/objects-map? objects))
                          (update-fn objects)
                          objects)))))
    fdata))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; POINTER-MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn get-file-data
  "Get file data given a file instance."
  [system file]
  (if (offloaded? file)
    (let [storage (sto/resolve system ::db/reuse-conn true)]
      (->> (sto/get-object storage (:data-ref-id file))
           (sto/get-object-bytes storage)))
    (:data file)))

(defn resolve-file-data
  [system file]
  (let [data (get-file-data system file)]
    (assoc file :data data)))

(defn decode-file-data
  [{:keys [::wrk/executor]} {:keys [data] :as file}]
  (cond-> file
    (bytes? data)
    (assoc :data (px/invoke! executor #(blob/decode data)))))

(defn load-pointer
  "A database loader pointer helper"
  [system file-id id]
  (let [fragment (db/get* system :file-data-fragment
                          {:id id :file-id file-id}
                          {::sql/columns [:data :data-backend :data-ref-id :id]})]

    (l/trc :hint "load pointer"
           :file-id (str file-id)
           :id (str id)
           :found (some? fragment))

    (when-not fragment
      (ex/raise :type :internal
                :code :fragment-not-found
                :hint "fragment not found"
                :file-id file-id
                :fragment-id id))

    (let [data (get-file-data system fragment)]
      ;; FIXME: conditional thread scheduling for decoding big objects
      (blob/decode data))))

(defn persist-pointers!
  "Persist all currently tracked pointer objects"
  [system file-id]
  (let [conn (db/get-connection system)]
    (doseq [[id item] @pmap/*tracked*]
      (when (pmap/modified? item)
        (l/trc :hint "persist pointer" :file-id (str file-id) :id (str id))
        (let [content (-> item deref blob/encode)]
          (db/insert! conn :file-data-fragment
                      {:id id
                       :file-id file-id
                       :data content}))))))

(defn process-pointers
  "Apply a function to all pointers on the file. Usuly used for
  dereference the pointer to a plain value before some processing."
  [fdata update-fn]
  (let [update-fn' (fn [val]
                     (if (pmap/pointer-map? val)
                       (update-fn val)
                       val))]
    (-> fdata
        (d/update-vals update-fn')
        (update :pages-index d/update-vals update-fn'))))

(defn get-used-pointer-ids
  "Given a file, return all pointer ids used in the data."
  [fdata]
  (->> (concat (vals fdata)
               (vals (:pages-index fdata)))
       (into #{} (comp (filter pmap/pointer-map?)
                       (map pmap/get-id)))))

(defn enable-pointer-map
  "Enable the fdata/pointer-map feature on the file."
  [file & _opts]
  (-> file
      (update :data (fn [fdata]
                      (-> fdata
                          (update :pages-index d/update-vals pmap/wrap)
                          (d/update-when :components pmap/wrap))))
      (update :features conj "fdata/pointer-map")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PATH-DATA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn enable-path-data
  "Enable the fdata/path-data feature on the file."
  [file & _opts]
  (letfn [(update-object [object]
            (if (or (cfh/path-shape? object)
                    (cfh/bool-shape? object))
              (update object :content path/content)
              object))

          (update-container [container]
            (d/update-when container :objects d/update-vals update-object))]

    (-> file
        (update :data (fn [data]
                        (-> data
                            (update :pages-index d/update-vals update-container)
                            (d/update-when :components d/update-vals update-container))))
        (update :features conj "fdata/path-data"))))

(defn disable-path-data
  [file & _opts]
  (letfn [(update-object [object]
            (if (or (cfh/path-shape? object)
                    (cfh/bool-shape? object))
              (update object :content vec)
              object))

          (update-container [container]
            (d/update-when container :objects d/update-vals update-object))]

    (when-let [conn db/*conn*]
      (db/delete! conn :file-migration {:file-id (:id file)
                                        :name "0003-convert-path-content"}))
    (-> file
        (update :data (fn [data]
                        (-> data
                            (update :pages-index d/update-vals update-container)
                            (d/update-when :components d/update-vals update-container))))
        (update :features disj "fdata/path-data")
        (update :migrations disj "0003-convert-path-content")
        (vary-meta update ::fmg/migrated disj "0003-convert-path-content"))))