penpot/backend/src/app/binfile/v3.clj
2025-05-20 13:06:07 +02:00

1033 lines
34 KiB
Clojure

;; 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.binfile.v3
"A ZIP based binary file exportation"
(:refer-clojure :exclude [read])
(:require
[app.binfile.cleaner :as bfl]
[app.binfile.common :as bfc]
[app.binfile.migrations :as bfm]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.migrations :as-alias fmg]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.media :as cmedia]
[app.common.schema :as sm]
[app.common.thumbnails :as cth]
[app.common.types.color :as ctcl]
[app.common.types.component :as ctc]
[app.common.types.file :as ctf]
[app.common.types.page :as ctp]
[app.common.types.plugins :as ctpg]
[app.common.types.shape :as cts]
[app.common.types.tokens-lib :as cto]
[app.common.types.typography :as cty]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.storage :as sto]
[app.storage.impl :as sto.impl]
[app.util.events :as events]
[app.util.time :as dt]
[clojure.java.io :as jio]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[datoteka.io :as io])
(:import
java.io.InputStream
java.io.OutputStreamWriter
java.util.zip.ZipEntry
java.util.zip.ZipFile
java.util.zip.ZipOutputStream))
;; --- SCHEMA
(def ^:private schema:manifest
[:map {:title "Manifest"}
[:version ::sm/int]
[:type :string]
[:generated-by {:optional true} :string]
[:files
[:vector
[:map
[:id ::sm/uuid]
[:name :string]
[:features ::cfeat/features]]]]
[:relations {:optional true}
[:vector
[:tuple ::sm/uuid ::sm/uuid]]]])
(def ^:private schema:storage-object
[:map {:title "StorageObject"}
[:id ::sm/uuid]
[:size ::sm/int]
[:content-type :string]
[:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
[:hash {:optional true} :string]])
(def ^:private schema:file-thumbnail
[:map {:title "FileThumbnail"}
[:file-id ::sm/uuid]
[:page-id ::sm/uuid]
[:frame-id ::sm/uuid]
[:tag :string]
[:media-id ::sm/uuid]])
(def ^:private schema:file
[:merge
ctf/schema:file
[:map [:options {:optional true} ctf/schema:options]]])
;; --- HELPERS
(defn- default-now
[o]
(or o (dt/now)))
;; --- ENCODERS
(def encode-file
(sm/encoder schema:file sm/json-transformer))
(def encode-page
(sm/encoder ctp/schema:page sm/json-transformer))
(def encode-shape
(sm/encoder ::cts/shape sm/json-transformer))
(def encode-media
(sm/encoder ::ctf/media sm/json-transformer))
(def encode-component
(sm/encoder ::ctc/component sm/json-transformer))
(def encode-color
(sm/encoder ::ctcl/color sm/json-transformer))
(def encode-typography
(sm/encoder ::cty/typography sm/json-transformer))
(def encode-tokens-lib
(sm/encoder ::cto/tokens-lib sm/json-transformer))
(def encode-plugin-data
(sm/encoder ::ctpg/plugin-data sm/json-transformer))
(def encode-storage-object
(sm/encoder schema:storage-object sm/json-transformer))
(def encode-file-thumbnail
(sm/encoder schema:file-thumbnail sm/json-transformer))
;; --- DECODERS
(def decode-manifest
(sm/decoder schema:manifest sm/json-transformer))
(def decode-media
(sm/decoder ctf/schema:media sm/json-transformer))
(def decode-component
(sm/decoder ::ctc/component sm/json-transformer))
(def decode-color
(sm/decoder ::ctcl/color sm/json-transformer))
(def decode-file
(sm/decoder schema:file sm/json-transformer))
(def decode-page
(sm/decoder ::ctp/page sm/json-transformer))
(def decode-shape
(sm/decoder ::cts/shape sm/json-transformer))
(def decode-typography
(sm/decoder ::cty/typography sm/json-transformer))
(def decode-tokens-lib
(sm/decoder ::cto/tokens-lib sm/json-transformer))
(def decode-plugin-data
(sm/decoder ::ctpg/plugin-data sm/json-transformer))
(def decode-storage-object
(sm/decoder schema:storage-object sm/json-transformer))
(def decode-file-thumbnail
(sm/decoder schema:file-thumbnail sm/json-transformer))
;; --- VALIDATORS
(def validate-manifest
(sm/check-fn schema:manifest))
(def validate-file
(sm/check-fn ::ctf/file))
(def validate-page
(sm/check-fn ::ctp/page))
(def validate-shape
(sm/check-fn ::cts/shape))
(def validate-media
(sm/check-fn ::ctf/media))
(def validate-color
(sm/check-fn ::ctcl/color))
(def validate-component
(sm/check-fn ::ctc/component))
(def validate-typography
(sm/check-fn ::cty/typography))
(def validate-tokens-lib
(sm/check-fn ::cto/tokens-lib))
(def validate-plugin-data
(sm/check-fn ::ctpg/plugin-data))
(def validate-storage-object
(sm/check-fn schema:storage-object))
(def validate-file-thumbnail
(sm/check-fn schema:file-thumbnail))
;; --- EXPORT IMPL
(defn- write-entry!
[^ZipOutputStream output ^String path data]
(.putNextEntry output (ZipEntry. path))
(let [writer (OutputStreamWriter. output "UTF-8")]
(json/write writer data :indent true :key-fn json/write-camel-key)
(.flush writer))
(.closeEntry output))
(defn- get-file
[{:keys [::bfc/embed-assets ::bfc/include-libraries] :as cfg} file-id]
(when (and include-libraries embed-assets)
(throw (IllegalArgumentException.
"the `include-libraries` and `embed-assets` are mutally excluding options")))
(let [detach? (and (not embed-assets) (not include-libraries))]
(db/tx-run! cfg (fn [cfg]
(cond-> (bfc/get-file cfg file-id {::sql/for-update true})
detach?
(-> (ctf/detach-external-references file-id)
(dissoc :libraries))
embed-assets
(update :data #(bfc/embed-assets cfg % file-id))
:always
(bfc/clean-file-features))))))
(defn- export-storage-objects
[{:keys [::output] :as cfg}]
(let [storage (sto/resolve cfg)]
(doseq [id (-> bfc/*state* deref :storage-objects not-empty)]
(let [sobject (sto/get-object storage id)
smeta (meta sobject)
ext (cmedia/mtype->extension (:content-type smeta))
path (str "objects/" id ".json")
params (-> (meta sobject)
(assoc :id (:id sobject))
(assoc :size (:size sobject))
(encode-storage-object))]
(write-entry! output path params)
(with-open [input (sto/get-object-data storage sobject)]
(.putNextEntry output (ZipEntry. (str "objects/" id ext)))
(io/copy input output :size (:size sobject))
(.closeEntry output))))))
(defn- export-file
[{:keys [::file-id ::output] :as cfg}]
(let [file (get-file cfg file-id)
media (->> (bfc/get-file-media cfg file)
(map (fn [media]
(dissoc media :file-id))))
data (:data file)
typographies (:typographies data)
components (:components data)
colors (:colors data)
tokens-lib (:tokens-lib data)
pages (:pages data)
pages-index (:pages-index data)
thumbnails (bfc/get-file-object-thumbnails cfg file-id)]
(vswap! bfc/*state* update :files assoc file-id
{:id file-id
:name (:name file)
:features (:features file)})
(let [file (cond-> (select-keys file bfc/file-attrs)
(:options data)
(assoc :options (:options data))
:always
(dissoc :data)
:always
(encode-file))
path (str "files/" file-id ".json")]
(write-entry! output path file))
(doseq [[index page-id] (d/enumerate pages)]
(let [path (str "files/" file-id "/pages/" page-id ".json")
page (get pages-index page-id)
objects (:objects page)
page (-> page
(dissoc :objects)
(assoc :index index))
page (encode-page page)]
(write-entry! output path page)
(doseq [[shape-id shape] objects]
(let [path (str "files/" file-id "/pages/" page-id "/" shape-id ".json")
shape (assoc shape :page-id page-id)
shape (encode-shape shape)]
(write-entry! output path shape)))))
(vswap! bfc/*state* bfc/collect-storage-objects media)
(vswap! bfc/*state* bfc/collect-storage-objects thumbnails)
(doseq [{:keys [id] :as media} media]
(let [path (str "files/" file-id "/media/" id ".json")
media (encode-media media)]
(write-entry! output path media)))
(doseq [thumbnail thumbnails]
(let [data (cth/parse-object-id (:object-id thumbnail))
path (str "files/" file-id "/thumbnails/" (:tag data) "/" (:page-id data)
"/" (:frame-id data) ".json")
data (-> data
(assoc :media-id (:media-id thumbnail))
(encode-file-thumbnail))]
(write-entry! output path data)))
(doseq [[id component] components]
(let [path (str "files/" file-id "/components/" id ".json")
component (encode-component component)]
(write-entry! output path component)))
(doseq [[id color] colors]
(let [path (str "files/" file-id "/colors/" id ".json")
color (-> (encode-color color)
(dissoc :file-id))
color (cond-> color
(and (contains? color :path)
(str/empty? (:path color)))
(dissoc :path))]
(write-entry! output path color)))
(doseq [[id object] typographies]
(let [path (str "files/" file-id "/typographies/" id ".json")
typography (encode-typography object)]
(write-entry! output path typography)))
(when tokens-lib
(let [path (str "files/" file-id "/tokens.json")
encoded-tokens (encode-tokens-lib tokens-lib)]
(write-entry! output path encoded-tokens)))))
(defn- export-files
[{:keys [::bfc/ids ::bfc/include-libraries ::output] :as cfg}]
(let [ids (into ids (when include-libraries (bfc/get-libraries cfg ids)))
rels (if include-libraries
(->> (bfc/get-files-rels cfg ids)
(mapv (juxt :file-id :library-file-id)))
[])]
(vswap! bfc/*state* assoc :files (d/ordered-map))
;; Write all the exporting files
(doseq [[index file-id] (d/enumerate ids)]
(-> cfg
(assoc ::file-id file-id)
(assoc ::file-seqn index)
(export-file)))
;; Write manifest file
(let [files (:files @bfc/*state*)
params {:type "penpot/export-files"
:version 1
:generated-by (str "penpot/" (:full cf/version))
:files (vec (vals files))
:relations rels}]
(write-entry! output "manifest.json" params))))
;; --- IMPORT IMPL
(defn- read-zip-entries
[^ZipFile input]
(into #{} (iterator-seq (.entries input))))
(defn- get-zip-entry*
[^ZipFile input ^String path]
(.getEntry input path))
(defn- get-zip-entry
[input path]
(let [entry (get-zip-entry* input path)]
(when-not entry
(ex/raise :type :validation
:code :inconsistent-penpot-file
:hint "the penpot file seems corrupt, missing underlying zip entry"
:path path))
entry))
(defn- get-zip-entry-size
[^ZipEntry entry]
(.getSize entry))
(defn- zip-entry-name
[^ZipEntry entry]
(.getName entry))
(defn- zip-entry-stream
^InputStream
[^ZipFile input ^ZipEntry entry]
(.getInputStream input entry))
(defn- zip-entry-reader
[^ZipFile input ^ZipEntry entry]
(-> (zip-entry-stream input entry)
(io/reader :encoding "UTF-8")))
(defn- zip-entry-storage-content
"Wraps a ZipFile and ZipEntry into a penpot storage compatible
object and avoid creating temporal objects"
[input entry]
(let [hash (delay (->> entry
(zip-entry-stream input)
(sto.impl/calculate-hash)))]
(reify
sto.impl/IContentObject
(get-size [_]
(get-zip-entry-size entry))
sto.impl/IContentHash
(get-hash [_]
(deref hash))
jio/IOFactory
(make-reader [this opts]
(jio/make-reader this opts))
(make-writer [_ _]
(throw (UnsupportedOperationException. "not implemented")))
(make-input-stream [_ _]
(zip-entry-stream input entry))
(make-output-stream [_ _]
(throw (UnsupportedOperationException. "not implemented"))))))
(defn- read-manifest
[^ZipFile input]
(let [entry (get-zip-entry input "manifest.json")]
(with-open [reader (zip-entry-reader input entry)]
(let [manifest (json/read reader :key-fn json/read-kebab-key)]
(decode-manifest manifest)))))
(defn- match-media-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/media/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- match-color-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/colors/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- match-component-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/components/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- match-typography-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/typographies/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- match-tokens-lib-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/tokens.json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_] (re-matches pattern (zip-entry-name entry))]
{:entry entry}))))
(defn- match-thumbnail-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/thumbnails/([^/]+)/([^/]+)/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ tag page-id frame-id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:tag tag
:page-id (parse-uuid page-id)
:frame-id (parse-uuid frame-id)
:file-id file-id}))))
(defn- match-page-entry-fn
[file-id]
(let [pattern (str "^files/" file-id "/pages/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- match-shape-entry-fn
[file-id page-id]
(let [pattern (str "^files/" file-id "/pages/" page-id "/([^/]+).json$")
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:page-id page-id
:id (parse-uuid id)}))))
(defn- match-storage-entry-fn
[]
(let [pattern "^objects/([^/]+).json$"
pattern (re-pattern pattern)]
(fn [entry]
(when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
{:entry entry
:id (parse-uuid id)}))))
(defn- read-entry
[^ZipFile input entry]
(with-open [reader (zip-entry-reader input entry)]
(json/read reader :key-fn json/read-kebab-key)))
(defn- read-plain-entry
[^ZipFile input entry]
(with-open [reader (zip-entry-reader input entry)]
(json/read reader)))
(defn- read-file
[{:keys [::bfc/input ::file-id]}]
(let [path (str "files/" file-id ".json")
entry (get-zip-entry input path)]
(-> (read-entry input entry)
(decode-file)
(validate-file))))
(defn- read-file-plugin-data
[{:keys [::bfc/input ::file-id]}]
(let [path (str "files/" file-id "/plugin-data.json")
entry (get-zip-entry* input path)]
(some->> entry
(read-entry input)
(decode-plugin-data)
(validate-plugin-data))))
(defn- read-file-media
[{:keys [::bfc/input ::file-id ::entries]}]
(->> (keep (match-media-entry-fn file-id) entries)
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry input entry)
(decode-media)
(validate-media))
object (-> object
(assoc :file-id file-id)
(update :created-at default-now)
(update :modified-at default-now)
;; FIXME: this is set default to true for
;; setting a value, this prop is no longer
;; relevant;
(assoc :is-local true))]
(if (= id (:id object))
(conj result object)
result)))
[])
(not-empty)))
(defn- read-file-colors
[{:keys [::bfc/input ::file-id ::entries]}]
(->> (keep (match-color-entry-fn file-id) entries)
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry input entry)
(decode-color)
(validate-color))]
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty)))
(defn- read-file-components
[{:keys [::bfc/input ::file-id ::entries]}]
(let [clean-component-post-decode
(fn [component]
(d/update-when component :objects
(fn [objects]
(reduce-kv (fn [objects id shape]
(assoc objects id (bfl/clean-shape-post-decode shape)))
objects
objects))))
clean-component-pre-decode
(fn [component]
(d/update-when component :objects
(fn [objects]
(reduce-kv (fn [objects id shape]
(assoc objects id (bfl/clean-shape-pre-decode shape)))
objects
objects))))]
(->> (keep (match-component-entry-fn file-id) entries)
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry input entry)
(clean-component-pre-decode)
(decode-component)
(clean-component-post-decode)
(validate-component))]
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty))))
(defn- read-file-typographies
[{:keys [::bfc/input ::file-id ::entries]}]
(->> (keep (match-typography-entry-fn file-id) entries)
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry input entry)
(decode-typography)
(validate-typography))]
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty)))
(defn- read-file-tokens-lib
[{:keys [::bfc/input ::file-id ::entries]}]
(when-let [entry (d/seek (match-tokens-lib-entry-fn file-id) entries)]
(->> (read-plain-entry input entry)
(decode-tokens-lib)
(validate-tokens-lib))))
(defn- read-file-shapes
[{:keys [::bfc/input ::file-id ::page-id ::entries] :as cfg}]
(->> (keep (match-shape-entry-fn file-id page-id) entries)
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry input entry)
(bfl/clean-shape-pre-decode)
(decode-shape)
(bfl/clean-shape-post-decode)
(validate-shape))]
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty)))
(defn- read-file-pages
[{:keys [::bfc/input ::file-id ::entries] :as cfg}]
(->> (keep (match-page-entry-fn file-id) entries)
(keep (fn [{:keys [id entry]}]
(let [page (->> (read-entry input entry)
(decode-page))
page (dissoc page :options)]
(when (= id (:id page))
(let [objects (-> (assoc cfg ::page-id id)
(read-file-shapes))]
(assoc page :objects objects))))))
(sort-by :index)
(reduce (fn [result {:keys [id] :as page}]
(assoc result id (dissoc page :index)))
(d/ordered-map))))
(defn- read-file-thumbnails
[{:keys [::bfc/input ::file-id ::entries] :as cfg}]
(->> (keep (match-thumbnail-entry-fn file-id) entries)
(reduce (fn [result {:keys [page-id frame-id tag entry]}]
(let [object (->> (read-entry input entry)
(decode-file-thumbnail)
(validate-file-thumbnail))]
(if (and (= frame-id (:frame-id object))
(= page-id (:page-id object))
(= tag (:tag object)))
(conj result object)
result)))
[])
(not-empty)))
(defn- read-file-data
[cfg]
(let [colors (read-file-colors cfg)
typographies (read-file-typographies cfg)
tokens-lib (read-file-tokens-lib cfg)
components (read-file-components cfg)
plugin-data (read-file-plugin-data cfg)
pages (read-file-pages cfg)]
{:pages (-> pages keys vec)
:pages-index (into {} pages)
:colors colors
:typographies typographies
:tokens-lib tokens-lib
:components components
:plugin-data plugin-data}))
(defn- import-file
[{:keys [::bfc/project-id ::file-id ::file-name] :as cfg}]
(let [file-id' (bfc/lookup-index file-id)
file (read-file cfg)
media (read-file-media cfg)
thumbnails (read-file-thumbnails cfg)]
(l/dbg :hint "processing file"
:id (str file-id')
:prev-id (str file-id)
:features (str/join "," (:features file))
:version (:version file)
::l/sync? true)
(events/tap :progress {:section :file :name file-name})
(when media
;; Update index with media
(l/dbg :hint "update media index"
:file-id (str file-id')
:total (count media)
::l/sync? true)
(vswap! bfc/*state* update :index bfc/update-index (map :id media))
(vswap! bfc/*state* update :media into media))
(when thumbnails
(l/dbg :hint "update thumbnails index"
:file-id (str file-id')
:total (count thumbnails)
::l/sync? true)
(vswap! bfc/*state* update :index bfc/update-index (map :media-id thumbnails))
(vswap! bfc/*state* update :thumbnails into thumbnails))
(let [data (-> (read-file-data cfg)
(d/without-nils)
(assoc :id file-id')
(cond-> (:options file)
(assoc :options (:options file))))
file (-> (select-keys file bfc/file-attrs)
(assoc :id file-id')
(assoc :data data)
(assoc :name file-name)
(assoc :project-id project-id)
(dissoc :options)
(bfc/process-file))]
(bfm/register-pending-migrations! cfg file)
(bfc/save-file! cfg file ::db/return-keys false)
file-id')))
(defn- import-file-relations
[{:keys [::db/conn ::manifest ::bfc/timestamp] :as cfg}]
(events/tap :progress {:section :relations})
(doseq [[file-id libr-id] (:relations manifest)]
(let [file-id (bfc/lookup-index file-id)
libr-id (bfc/lookup-index libr-id)]
(when (and file-id libr-id)
(l/dbg :hint "create file library link"
:file-id (str file-id)
:lib-id (str libr-id)
::l/sync? true)
(db/insert! conn :file-library-rel
{:synced-at timestamp
:file-id file-id
:library-file-id libr-id})))))
(defn- import-storage-objects
[{:keys [::bfc/input ::entries ::bfc/timestamp] :as cfg}]
(events/tap :progress {:section :storage-objects})
(let [storage (sto/resolve cfg)
entries (keep (match-storage-entry-fn) entries)]
(doseq [{:keys [id entry]} entries]
(let [object (->> (read-entry input entry)
(decode-storage-object)
(validate-storage-object))]
(when (not= id (:id object))
(ex/raise :type :validation
:code :inconsistent-penpot-file
:hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"
:expected-id (str id)
:found-id (str (:id object))))
(let [ext (cmedia/mtype->extension (:content-type object))
path (str "objects/" id ext)
content (->> path
(get-zip-entry input)
(zip-entry-storage-content input))]
(when (not= (:size object) (sto/get-size content))
(ex/raise :type :validation
:code :inconsistent-penpot-file
:hint "found corrupted storage object: size does not match"
:path path
:expected-size (:size object)
:found-size (sto/get-size content)))
(when-let [hash (get object :hash)]
(when (not= hash (sto/get-hash content))
(ex/raise :type :validation
:code :inconsistent-penpot-file
:hint "found corrupted storage object: hash does not match"
:path path
:expected-hash (:hash object)
:found-hash (sto/get-hash content))))
(let [params (-> object
(dissoc :id :size)
(assoc ::sto/content content)
(assoc ::sto/deduplicate? true)
(assoc ::sto/touched-at timestamp))
sobject (sto/put-object! storage params)]
(l/dbg :hint "persisted storage object"
:id (str (:id sobject))
:prev-id (str id)
:bucket (:bucket params)
::l/sync? true)
(vswap! bfc/*state* update :index assoc id (:id sobject))))))))
(defn- import-file-media
[{:keys [::db/conn] :as cfg}]
(events/tap :progress {:section :media})
(doseq [item (:media @bfc/*state*)]
(let [params (-> item
(update :id bfc/lookup-index)
(update :file-id bfc/lookup-index)
(d/update-when :media-id bfc/lookup-index)
(d/update-when :thumbnail-id bfc/lookup-index))]
(l/dbg :hint "inserting file media object"
:old-id (str (:id item))
:id (str (:id params))
:file-id (str (:file-id params))
::l/sync? true)
(db/insert! conn :file-media-object params))))
(defn- import-file-thumbnails
[{:keys [::db/conn] :as cfg}]
(events/tap :progress {:section :thumbnails})
(doseq [item (:thumbnails @bfc/*state*)]
(let [file-id (bfc/lookup-index (:file-id item))
media-id (bfc/lookup-index (:media-id item))
object-id (-> (assoc item :file-id file-id)
(cth/fmt-object-id))
params {:file-id file-id
:object-id object-id
:tag (:tag item)
:media-id media-id}]
(l/dbg :hint "inserting file object thumbnail"
:file-id (str file-id)
:media-id (str media-id)
::l/sync? true)
(db/insert! conn :file-tagged-object-thumbnail params))))
(defn- import-files
[{:keys [::bfc/timestamp ::bfc/input ::bfc/name] :or {timestamp (dt/now)} :as cfg}]
(dm/assert!
"expected zip file"
(instance? ZipFile input))
(dm/assert!
"expected valid instant"
(dt/instant? timestamp))
(let [manifest (-> (read-manifest input)
(validate-manifest))
entries (read-zip-entries input)]
(when-not (= "penpot/export-files" (:type manifest))
(ex/raise :type :validation
:code :invalid-binfile-v3-manifest
:hint "unexpected type on manifest"
:manifest manifest))
;; Check if all files referenced on manifest are present
(doseq [{file-id :id features :features} (:files manifest)]
(let [path (str "files/" file-id ".json")]
(when-not (get-zip-entry input path)
(ex/raise :type :validation
:code :invalid-binfile-v3
:hint "some files referenced on manifest not found"
:path path
:file-id file-id))
(cfeat/check-supported-features! features)))
(events/tap :progress {:section :manifest})
(let [index (bfc/update-index (map :id (:files manifest)))
state {:media [] :index index}
cfg (-> cfg
(assoc ::entries entries)
(assoc ::manifest manifest)
(assoc ::bfc/timestamp timestamp))]
(binding [bfc/*state* (volatile! state)]
(db/tx-run! cfg (fn [cfg]
(bfc/disable-database-timeouts! cfg)
(let [ids (->> (:files manifest)
(reduce (fn [result {:keys [id] :as file}]
(let [name' (get file :name)
name' (if (map? name)
(get name id)
name')]
(conj result (-> cfg
(assoc ::file-id id)
(assoc ::file-name name')
(import-file)))))
[]))]
(import-file-relations cfg)
(import-storage-objects cfg)
(import-file-media cfg)
(import-file-thumbnails cfg)
(bfm/apply-pending-migrations! cfg)
ids)))))))
;; --- PUBLIC API
(defn export-files!
"Do the exportation of a specified file in custom penpot binary
format. There are some options available for customize the output:
`::bfc/include-libraries`: additionally to the specified file, all the
linked libraries also will be included (including transitive
dependencies).
`::bfc/embed-assets`: instead of including the libraries, embed in the
same file library all assets used from external libraries."
[{:keys [::bfc/ids] :as cfg} output]
(dm/assert!
"expected a set of uuid's for `::bfc/ids` parameter"
(and (set? ids)
(every? uuid? ids)))
(dm/assert!
"expected instance of jio/IOFactory for `input`"
(satisfies? jio/IOFactory output))
(let [id (uuid/next)
tp (dt/tpoint)
ab (volatile! false)
cs (volatile! nil)]
(try
(l/info :hint "start exportation" :export-id (str id))
(binding [bfc/*state* (volatile! (bfc/initial-state))]
(with-open [output (io/output-stream output)]
(with-open [output (ZipOutputStream. output)]
(let [cfg (assoc cfg ::output output)]
(export-files cfg)
(export-storage-objects cfg)))))
(catch java.util.zip.ZipException cause
(vreset! cs cause)
(vreset! ab true)
(throw cause))
(catch java.io.IOException _cause
;; Do nothing, EOF means client closes connection abruptly
(vreset! ab true)
nil)
(catch Throwable cause
(vreset! cs cause)
(vreset! ab true)
(throw cause))
(finally
(l/info :hint "exportation finished" :export-id (str id)
:elapsed (str (inst-ms (tp)) "ms")
:aborted @ab
:cause @cs)))))
(defn import-files!
[{:keys [::bfc/input] :as cfg}]
(dm/assert!
"expected valid profile-id and project-id on `cfg`"
(and (uuid? (::bfc/profile-id cfg))
(uuid? (::bfc/project-id cfg))))
(dm/assert!
"expected instance of jio/IOFactory for `input`"
(io/coercible? input))
(let [id (uuid/next)
tp (dt/tpoint)
cs (volatile! nil)]
(l/info :hint "import: started" :id (str id))
(try
(with-open [input (ZipFile. (fs/file input))]
(import-files (assoc cfg ::bfc/input input)))
(catch Throwable cause
(vreset! cs cause)
(throw cause))
(finally
(l/info :hint "import: terminated"
:id (str id)
:elapsed (dt/format-duration (tp))
:error? (some? @cs))))))