mirror of
https://github.com/penpot/penpot.git
synced 2025-05-19 17:06:13 +02:00
fa06da36ac
That causes many troubles on configuring exporter on the onpremise instances but serves for nothing because it is completly unused.
214 lines
8.2 KiB
Clojure
214 lines
8.2 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) UXBOX Labs SL
|
|
|
|
(ns app.handlers.export-shapes
|
|
(:require
|
|
["path" :as path]
|
|
[app.common.data :as d]
|
|
[app.common.exceptions :as exc]
|
|
[app.common.logging :as l]
|
|
[app.common.spec :as us]
|
|
[app.handlers.resources :as rsc]
|
|
[app.redis :as redis]
|
|
[app.renderer :as rd]
|
|
[app.util.mime :as mime]
|
|
[app.util.shell :as sh]
|
|
[cljs.spec.alpha :as s]
|
|
[cuerdas.core :as str]
|
|
[promesa.core :as p]))
|
|
|
|
(declare ^:private handle-single-export)
|
|
(declare ^:private handle-multiple-export)
|
|
(declare ^:private assoc-file-name)
|
|
(declare prepare-exports)
|
|
|
|
(s/def ::file-id ::us/uuid)
|
|
(s/def ::filename ::us/string)
|
|
(s/def ::name ::us/string)
|
|
(s/def ::object-id ::us/uuid)
|
|
(s/def ::page-id ::us/uuid)
|
|
(s/def ::profile-id ::us/uuid)
|
|
(s/def ::scale ::us/number)
|
|
(s/def ::suffix ::us/string)
|
|
(s/def ::type ::us/keyword)
|
|
(s/def ::wait ::us/boolean)
|
|
|
|
(s/def ::export
|
|
(s/keys :req-un [::page-id ::file-id ::object-id ::type ::suffix ::scale ::name]))
|
|
|
|
(s/def ::exports
|
|
(s/coll-of ::export :kind vector? :min-count 1))
|
|
|
|
(s/def ::params
|
|
(s/keys :req-un [::exports ::profile-id]
|
|
:opt-un [::wait ::name]))
|
|
|
|
(defn handler
|
|
[{:keys [:request/auth-token] :as exchange} {:keys [exports] :as params}]
|
|
(let [exports (prepare-exports exports auth-token)]
|
|
(if (and (= 1 (count exports))
|
|
(= 1 (count (-> exports first :objects))))
|
|
(handle-single-export exchange (-> params
|
|
(assoc :export (first exports))
|
|
(dissoc :exports)))
|
|
(handle-multiple-export exchange (assoc params :exports exports)))))
|
|
|
|
(defn- handle-single-export
|
|
[exchange {:keys [export wait profile-id name] :as params}]
|
|
(let [topic (str profile-id)
|
|
resource (rsc/create (:type export) (or name (:name export)))
|
|
|
|
on-progress (fn [{:keys [path] :as object}]
|
|
(p/do
|
|
;; Move the generated path to the resource
|
|
;; path destination.
|
|
(sh/move! path (:path resource))
|
|
|
|
(when-not wait
|
|
(redis/pub! topic {:type :export-update
|
|
:resource-id (:id resource)
|
|
:status "running"
|
|
:total 1
|
|
:done 1})
|
|
(redis/pub! topic {:type :export-update
|
|
:resource-id (:id resource)
|
|
:filename (:filename resource)
|
|
:name (:name resource)
|
|
:status "ended"}))))
|
|
on-error (fn [cause]
|
|
(l/error :hint "unexpected error happened on export multiple process"
|
|
:cause cause)
|
|
(if wait
|
|
(p/rejected cause)
|
|
(redis/pub! topic {:type :export-update
|
|
:resource-id (:id resource)
|
|
:status "error"
|
|
:cause (ex-message cause)})))
|
|
|
|
proc (-> (rd/render export on-progress)
|
|
(p/then (constantly resource))
|
|
(p/catch on-error))]
|
|
|
|
(if wait
|
|
(p/then proc #(assoc exchange :response/body (dissoc % :path)))
|
|
(assoc exchange :response/body (dissoc resource :path)))))
|
|
|
|
(defn- handle-multiple-export
|
|
[exchange {:keys [exports wait profile-id name] :as params}]
|
|
(let [resource (rsc/create :zip (or name (-> exports first :name)))
|
|
total (count exports)
|
|
topic (str profile-id)
|
|
|
|
to-delete (atom #{})
|
|
|
|
on-progress (fn [{:keys [done]}]
|
|
(when-not wait
|
|
(let [data {:type :export-update
|
|
:resource-id (:id resource)
|
|
:status "running"
|
|
:total total
|
|
:done done}]
|
|
(redis/pub! topic data))))
|
|
|
|
on-complete (fn []
|
|
(when-not wait
|
|
(let [data {:type :export-update
|
|
:name (:name resource)
|
|
:filename (:filename resource)
|
|
:resource-id (:id resource)
|
|
:status "ended"}]
|
|
(redis/pub! topic data))))
|
|
|
|
on-error (fn [cause]
|
|
(l/error :hint "unexpected error on multiple exportation" :cause cause)
|
|
(if wait
|
|
(p/rejected cause)
|
|
(redis/pub! topic {:type :export-update
|
|
:resource-id (:id resource)
|
|
:status "error"
|
|
:cause (ex-message cause)})))
|
|
|
|
zip (rsc/create-zip :resource resource
|
|
:on-complete on-complete
|
|
:on-error on-error
|
|
:on-progress on-progress)
|
|
|
|
append (fn [{:keys [filename path] :as object}]
|
|
(swap! to-delete conj path)
|
|
(rsc/add-to-zip! zip path filename))
|
|
|
|
proc (-> (p/do
|
|
(p/loop [exports (seq exports)]
|
|
(when-let [export (first exports)]
|
|
(p/let [proc (rd/render export append)]
|
|
(p/recur (rest exports)))))
|
|
(.finalize zip))
|
|
(p/then (fn [_] (p/run! #(sh/rmdir! (path/dirname %)) @to-delete)))
|
|
(p/then (constantly resource))
|
|
(p/catch on-error))
|
|
]
|
|
|
|
(if wait
|
|
(p/then proc #(assoc exchange :response/body (dissoc % :path)))
|
|
(assoc exchange :response/body (dissoc resource :path)))))
|
|
|
|
|
|
(defn- assoc-file-name
|
|
"A transducer that assocs a candidate filename and avoid duplicates."
|
|
[]
|
|
(letfn [(find-candidate [params used]
|
|
(loop [index 0]
|
|
(let [candidate (str (:name params)
|
|
(:suffix params "")
|
|
(when (pos? index)
|
|
(str/concat "-" (inc index)))
|
|
(mime/get-extension (:type params)))]
|
|
(if (contains? used candidate)
|
|
(recur (inc index))
|
|
candidate))))]
|
|
(fn [rf]
|
|
(let [used (volatile! #{})]
|
|
(fn
|
|
([] (rf))
|
|
([result] (rf result))
|
|
([result params]
|
|
(let [candidate (find-candidate params @used)
|
|
params (assoc params :filename candidate)]
|
|
(vswap! used conj candidate)
|
|
(rf result params))))))))
|
|
|
|
(def ^:const ^:private
|
|
default-partition-size 50)
|
|
|
|
(defn prepare-exports
|
|
[exports token]
|
|
(letfn [(process-group [group]
|
|
(sequence (comp (partition-all default-partition-size)
|
|
(map process-partition))
|
|
group))
|
|
|
|
(process-partition [[part1 :as part]]
|
|
{:file-id (:file-id part1)
|
|
:page-id (:page-id part1)
|
|
:name (:name part1)
|
|
:token token
|
|
:type (:type part1)
|
|
:scale (:scale part1)
|
|
:objects (mapv part-entry->object part)})
|
|
|
|
(part-entry->object [entry]
|
|
{:id (:object-id entry)
|
|
:filename (:filename entry)
|
|
:name (:name entry)
|
|
:suffix (:suffix entry)})]
|
|
|
|
(let [xform (comp
|
|
(map #(assoc % :token token))
|
|
(assoc-file-name))]
|
|
(->> (sequence xform exports)
|
|
(d/group-by (juxt :scale :type))
|
|
(map second)
|
|
(into [] (mapcat process-group))))))
|