Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-13 08:11:30 -05:00
Code Issues Activity

♻️ Reorganize workspace persistence related namespace

Browse source
This commit is contained in:
Andrey Antukh 2022-04-21 13:28:47 +02:00 • committed by Andrés Moya
parent 3ab3ea68b4
commit c01e4e52f8
21 changed files with 503 additions and 536 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
common/src/app/common/media.cljc
View file

@ -44,6 +44,21 @@
"image/svg+xml" :svg
nil))
(defn mtype->extension [mtype]
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
(case mtype
"image/apng" ".apng"
"image/avif" ".avif"
"image/gif" ".gif"
"image/jpeg" ".jpg"
"image/png" ".png"
"image/svg+xml" ".svg"
"image/webp" ".webp"
"application/zip" ".zip"
"application/penpot" ".penpot"
"application/pdf" ".pdf"
nil))
(def max-file-size (* 5 1024 1024))
(s/def ::id uuid?)

9
frontend/src/app/main/data/media.cljs
View file

@ -17,15 +17,14 @@
;; --- Predicates
(defn ^boolean file?
(defn file?
[o]
(instance? js/File o))
(defn ^boolean blob?
(defn blob?
[o]
(instance? js/Blob o))
;; --- Specs
(s/def ::blob blob?)
@ -36,8 +35,7 @@
;; --- Utility functions
(defn validate-file
;; Check that a file obtained with the file javascript API is valid.
(defn validate-file ;; Check that a file obtained with the file javascript API is valid.
[file]
(when (> (.-size file) cm/max-file-size)
(ex/raise :type :validation
@ -74,4 +72,3 @@
:else
(tr "errors.unexpected-error"))]
(rx/of (dm/error msg))))

20
frontend/src/app/main/data/workspace.cljs
View file

@ -36,13 +36,13 @@
[app.main.data.workspace.layers :as dwly]
[app.main.data.workspace.layout :as layout]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.notifications :as dwn]
[app.main.data.workspace.path :as dwdp]
[app.main.data.workspace.path.shapes-to-path :as dwps]
[app.main.data.workspace.persistence :as dwp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.svg-upload :as svg]
[app.main.data.workspace.thumbnails :as dwth]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
@ -1606,6 +1606,7 @@
(dwc/add-shape shape)
(dwu/commit-undo-transaction))))))
;; TODO: why not implement it in terms of upload-media-workspace?
(defn- paste-svg
[text]
(us/assert string? text)
@ -1614,8 +1615,8 @@
(watch [_ state _]
(let [position (deref ms/mouse-position)
file-id (:current-file-id state)]
(->> (dwp/parse-svg ["svg" text])
(rx/map #(svg/svg-uploaded % file-id position)))))))
(->> (dwm/svg->clj ["svg" text])
(rx/map #(dwm/svg-uploaded % file-id position)))))))
(defn- paste-image
[image]
@ -1626,7 +1627,7 @@
params {:file-id file-id
:blobs [image]
:position @ms/mouse-position}]
(rx/of (dwp/upload-media-workspace params))))))
(rx/of (dwm/upload-media-workspace params))))))
(defn toggle-distances-display [value]
(ptk/reify ::toggle-distances-display
@ -1708,17 +1709,6 @@
(dm/export dwt/flip-vertical-selected)
(dm/export dwly/set-opacity)
;; Persistence
(dm/export dwp/set-file-shared)
(dm/export dwp/fetch-shared-files)
(dm/export dwp/link-file-to-library)
(dm/export dwp/unlink-file-from-library)
(dm/export dwp/upload-media-asset)
(dm/export dwp/upload-media-workspace)
(dm/export dwp/clone-media-object)
(dm/export dwc/image-uploaded)
;; Common
(dm/export dwc/add-shape)
(dm/export dwc/clear-edition-mode)

19
frontend/src/app/main/data/workspace/common.cljs
View file

@ -482,22 +482,3 @@
(assoc :frame-id frame-id)
(cp/setup-rect-selrect))]
(rx/of (add-shape shape))))))
(defn image-uploaded
[image {:keys [x y]}]
(ptk/reify ::image-uploaded
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [name width height id mtype]} image
shape {:name name
:width width
:height height
:x (- x (/ width 2))
:y (- y (/ height 2))
:metadata {:width width
:height height
:mtype mtype
:id id}}]
(rx/of (create-and-add-shape :image x y shape))))))

71
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -18,6 +18,7 @@
[app.common.spec.file :as spec.file]
[app.common.spec.typography :as spec.typography]
[app.common.uuid :as uuid]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
@ -31,6 +32,7 @@
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
@ -290,7 +292,7 @@
(-> component
(assoc :path path)
(assoc :name name)
(update :objects
(update :objects
;; Give the same name to the root shape
#(assoc-in % [id :name] name)))))
@ -673,3 +675,70 @@
:callback do-dismiss}]
:sync-dialog))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Backend interactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn set-file-shared
[id is-shared]
{:pre [(uuid? id) (boolean? is-shared)]}
(ptk/reify ::set-file-shared
IDeref
(-deref [_]
{::ev/origin "workspace" :id id :shared is-shared})
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-file :is-shared] is-shared))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
(defn- shared-files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
(let [state (dissoc state :files)]
(assoc state :workspace-shared-files files)))))
(defn fetch-shared-files
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched)))))
;; --- Link and unlink Files
(defn link-file-to-library
[file-id library-id]
(ptk/reify ::attach-library
ptk/WatchEvent
(watch [_ _ _]
(let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :link-file-to-library params)
(rx/mapcat #(rp/query :file {:id library-id}))
(rx/map #(partial fetched %)))))))
(defn unlink-file-from-library
[file-id library-id]
(ptk/reify ::detach-library
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:workspace-libraries library-id]))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :unlink-file-from-library params)
(rx/ignore))))))

286
frontend/src/app/main/data/workspace/media.cljs Normal file
View file

@ -0,0 +1,286 @@
;; 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.main.data.workspace.media
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.main.data.media :as dmm]
[app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.svg-upload :as svg]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.i18n :refer [tr]]
[app.util.svg :as usvg]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]
[tubax.core :as tubax]))
(defn svg->clj
[[name text]]
(try
(->> (rx/of (-> (tubax/xml->clj text)
(assoc :name name))))
(catch :default _err
(rx/throw {:type :svg-parser}))))
(defn extract-name [url]
(let [query-idx (str/last-index-of url "?")
url (if (> query-idx 0) (subs url 0 query-idx) url)
filename (->> (str/split url "/") (last))
ext-idx (str/last-index-of filename ".")]
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn data-uri->blob
[data-uri]
(let [[mtype b64-data] (str/split data-uri ";base64,")
mtype (subs mtype (inc (str/index-of mtype ":")))
decoded (.atob js/window b64-data)
size (.-length ^js decoded)
content (js/Uint8Array. size)]
(doseq [i (range 0 size)]
(aset content i (.charCodeAt decoded i)))
(wapi/create-blob content mtype)))
;; TODO: rename to bitmap-image-uploaded
(defn image-uploaded
[image {:keys [x y]}]
(ptk/reify ::image-uploaded
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [name width height id mtype]} image
shape {:name name
:width width
:height height
:x (- x (/ width 2))
:y (- y (/ height 2))
:metadata {:width width
:height height
:mtype mtype
:id id}}]
(rx/of (dwc/create-and-add-shape :image x y shape))))))
(defn svg-uploaded
[svg-data file-id position]
(ptk/reify ::svg-uploaded
ptk/WatchEvent
(watch [_ _ _]
;; Once the SVG is uploaded, we need to extract all the bitmap
;; images and upload them separately, then proceed to create
;; all shapes.
(->> (rx/from (usvg/collect-images svg-data))
(rx/map (fn [uri]
(merge
{:file-id file-id
:is-local true}
(if (str/starts-with? uri "data:")
{:name "image"
:content (data-uri->blob uri)}
{:name (extract-name uri)
:url uri}))))
(rx/mapcat (fn [uri-data]
(->> (rp/mutation! (if (contains? uri-data :content)
:upload-file-media-object
:create-file-media-object-from-url) uri-data)
;; When the image uploaded fail we skip the shape
;; returning `nil` will afterward not create the shape.
(rx/catch #(rx/of nil))
(rx/map #(vector (:url uri-data) %)))))
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
(rx/map #(svg/create-svg-shapes (assoc svg-data :image-data %) position))))))
(defn- process-uris
[{:keys [file-id local? name uris mtype on-image on-svg]}]
(letfn [(svg-url? [url]
(or (and mtype (= mtype "image/svg+xml"))
(str/ends-with? url ".svg")))
(prepare [uri]
{:file-id file-id
:is-local local?
:name (or name (extract-name uri))
:url uri})
(fetch-svg [name uri]
(->> (http/send! {:method :get :uri uri :mode :no-cors})
(rx/map #(vector
(or name (extract-name uri))
(:body %)))))]
(rx/merge
(->> (rx/from uris)
(rx/filter (comp not svg-url?))
(rx/map prepare)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
(rx/do on-image))
(->> (rx/from uris)
(rx/filter svg-url?)
(rx/merge-map (partial fetch-svg name))
(rx/merge-map svg->clj)
(rx/do on-svg)))))
(defn- process-blobs
[{:keys [file-id local? name blobs force-media on-image on-svg]}]
(letfn [(svg-blob? [blob]
(and (not force-media)
(= (.-type blob) "image/svg+xml")))
(prepare-blob [blob]
(let [name (or name (if (dmm/file? blob) (.-name blob) "blob"))]
{:file-id file-id
:name name
:is-local local?
:content blob}))
(extract-content [blob]
(let [name (or name (.-name blob))]
(-> (.text ^js blob)
(p/then #(vector name %)))))]
(rx/merge
(->> (rx/from blobs)
(rx/map dmm/validate-file)
(rx/filter (comp not svg-blob?))
(rx/map prepare-blob)
(rx/mapcat #(rp/mutation! :upload-file-media-object %))
(rx/do on-image))
(->> (rx/from blobs)
(rx/map dmm/validate-file)
(rx/filter svg-blob?)
(rx/merge-map extract-content)
(rx/merge-map svg->clj)
(rx/do on-svg)))))
(s/def ::local? ::us/boolean)
(s/def ::blobs ::dmm/blobs)
(s/def ::name ::us/string)
(s/def ::uris (s/coll-of ::us/string))
(s/def ::mtype ::us/string)
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(us/assert ::process-media-objects params)
(letfn [(handle-error [error]
(if (ex/ex-info? error)
(handle-error (ex-data error))
(cond
(= (:code error) :invalid-svg-file)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :unable-to-access-to-url)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-too-large)
(rx/of (dm/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(= (:code error) :unable-to-optimize)
(rx/of (dm/error (:hint error)))
(fn? on-error)
(on-error error)
:else
(rx/throw error))))]
(ptk/reify ::process-media-objects
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
;; Media objects is a list of URL's pointing to the path
(process-uris params)
;; Media objects are blob of data to be upload
(process-blobs params))
;; Every stream has its own sideeffect. We need to ignore the result
(rx/ignore)
(rx/catch handle-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
(defn upload-media-asset
[params]
(let [params (assoc params
:force-media true
:local? false
:on-image #(st/emit! (dwl/add-media %)))]
(process-media-objects params)))
;; TODO: it is really need handle SVG here, looks like it already
;; handled separatelly
(defn upload-media-workspace
[{:keys [position file-id] :as params}]
(let [params (assoc params
:local? true
:on-image #(st/emit! (image-uploaded % position))
:on-svg #(st/emit! (svg-uploaded % file-id position)))]
(process-media-objects params)))
;; --- Upload File Media objects
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::object-id]))
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error identity}} (meta params)
params {:is-local true
:file-id file-id
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (rp/mutation! :clone-file-media-object params)
(rx/do on-success)
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))

283
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -6,37 +6,28 @@
(ns app.main.data.workspace.persistence
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.spec.file :as spec.file]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.dashboard :as dd]
[app.main.data.events :as ev]
[app.main.data.fonts :as df]
[app.main.data.media :as di]
[app.main.data.messages :as dm]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.svg-upload :as svg]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.time :as dt]
[app.util.uri :as uu]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]
[tubax.core :as tubax]))
[clojure.set :as set]
[potok.core :as ptk]))
(declare persist-changes)
(declare persist-synchronous-changes)
@ -274,271 +265,6 @@
(rx/of (ptk/data-event ::bundle-fetched bundle)
(df/load-team-fonts (:team-id project)))))))))
;; --- Set File shared
(defn set-file-shared
[id is-shared]
{:pre [(uuid? id) (boolean? is-shared)]}
(ptk/reify ::set-file-shared
IDeref
(-deref [_]
{::ev/origin "workspace" :id id :shared is-shared})
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-file :is-shared] is-shared))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
;; --- Fetch Shared Files
(declare shared-files-fetched)
(defn fetch-shared-files
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched)))))
(defn shared-files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
(let [state (dissoc state :files)]
(assoc state :workspace-shared-files files)))))
;; --- Link and unlink Files
(defn link-file-to-library
[file-id library-id]
(ptk/reify ::attach-library
ptk/WatchEvent
(watch [_ _ _]
(let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :link-file-to-library params)
(rx/mapcat #(rp/query :file {:id library-id}))
(rx/map #(partial fetched %)))))))
(defn unlink-file-from-library
[file-id library-id]
(ptk/reify ::detach-library
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:workspace-libraries library-id]))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :unlink-file-from-library params)
(rx/ignore))))))
;; --- Upload File Media objects
(defn parse-svg
[[name text]]
(try
(->> (rx/of (-> (tubax/xml->clj text)
(assoc :name name))))
(catch :default _err
(rx/throw {:type :svg-parser}))))
(defn fetch-svg [name uri]
(->> (http/send! {:method :get :uri uri :mode :no-cors})
(rx/map #(vector
(or name (uu/uri-name uri))
(:body %)))))
(defn- handle-upload-error
"Generic error handler for all upload methods."
[on-error stream]
(letfn [(on-error* [error]
(if (ex/ex-info? error)
(on-error* (ex-data error))
(cond
(= (:code error) :invalid-svg-file)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :unable-to-access-to-url)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-too-large)
(rx/of (dm/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(= (:code error) :unable-to-optimize)
(rx/of (dm/error (:hint error)))
(fn? on-error)
(on-error error)
:else
(rx/throw error))))]
(rx/catch on-error* stream)))
(defn- process-uris
[{:keys [file-id local? name uris mtype on-image on-svg]}]
(letfn [(svg-url? [url]
(or (and mtype (= mtype "image/svg+xml"))
(str/ends-with? url ".svg")))
(prepare [uri]
{:file-id file-id
:is-local local?
:name (or name (uu/uri-name uri))
:url uri})]
(rx/merge
(->> (rx/from uris)
(rx/filter (comp not svg-url?))
(rx/map prepare)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
(rx/do on-image))
(->> (rx/from uris)
(rx/filter svg-url?)
(rx/merge-map (partial fetch-svg name))
(rx/merge-map parse-svg)
(rx/do on-svg)))))
(defn- process-blobs
[{:keys [file-id local? name blobs force-media on-image on-svg]}]
(letfn [(svg-blob? [blob]
(and (not force-media)
(= (.-type blob) "image/svg+xml")))
(prepare-blob [blob]
(let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
{:file-id file-id
:name name
:is-local local?
:content blob}))
(extract-content [blob]
(let [name (or name (.-name blob))]
(-> (.text ^js blob)
(p/then #(vector name %)))))]
(rx/merge
(->> (rx/from blobs)
(rx/map di/validate-file)
(rx/filter (comp not svg-blob?))
(rx/map prepare-blob)
(rx/mapcat #(rp/mutation! :upload-file-media-object %))
(rx/do on-image))
(->> (rx/from blobs)
(rx/map di/validate-file)
(rx/filter svg-blob?)
(rx/merge-map extract-content)
(rx/merge-map parse-svg)
(rx/do on-svg)))))
(s/def ::local? ::us/boolean)
(s/def ::blobs ::di/blobs)
(s/def ::name ::us/string)
(s/def ::uris (s/coll-of ::us/string))
(s/def ::mtype ::us/string)
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(us/assert ::process-media-objects params)
(ptk/reify ::process-media-objects
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
;; Media objects is a list of URL's pointing to the path
(process-uris params)
;; Media objects are blob of data to be upload
(process-blobs params))
;; Every stream has its own sideeffect. We need to ignore the result
(rx/ignore)
(handle-upload-error on-error)
(rx/finalize (st/emitf (dm/hide-tag :media-loading))))))))
(defn upload-media-asset
[params]
(let [params (assoc params
:force-media true
:local? false
:on-image #(st/emit! (dwl/add-media %)))]
(process-media-objects params)))
(defn upload-media-workspace
[{:keys [position file-id] :as params}]
(let [params (assoc params
:local? true
:on-image #(st/emit! (dwc/image-uploaded % position))
:on-svg #(st/emit! (svg/svg-uploaded % file-id position)))]
(process-media-objects params)))
;; --- Upload File Media objects
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::object-id]))
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error identity}} (meta params)
params {:is-local true
:file-id file-id
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (rp/mutation! :clone-file-media-object params)
(rx/do on-success)
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
;; --- Helpers
@ -549,7 +275,6 @@
(update-in [:workspace-file :pages] #(filterv (partial not= id) %))
(update :workspace-pages dissoc id)))
(defn preload-data-uris
"Preloads the image data so it's ready when necesary"
[]

33
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -19,11 +19,9 @@
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.repo :as rp]
[app.util.color :as uc]
[app.util.path.parser :as upp]
[app.util.svg :as usvg]
[app.util.uri :as uu]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]))
@ -429,37 +427,6 @@
[unames changes])))
(declare create-svg-shapes)
(defn svg-uploaded
[svg-data file-id position]
(ptk/reify ::svg-uploaded
ptk/WatchEvent
(watch [_ _ _]
;; Once the SVG is uploaded, we need to extract all the bitmap
;; images and upload them separately, then proceed to create
;; all shapes.
(->> (rx/from (usvg/collect-images svg-data))
(rx/map (fn [uri]
(merge
{:file-id file-id
:is-local true}
(if (str/starts-with? uri "data:")
{:name "image"
:content (uu/data-uri->blob uri)}
{:name (uu/uri-name uri)
:url uri}))))
(rx/mapcat (fn [uri-data]
(->> (rp/mutation! (if (contains? uri-data :content)
:upload-file-media-object
:create-file-media-object-from-url) uri-data)
;; When the image uploaded fail we skip the shape
;; returning `nil` will afterward not create the shape.
(rx/catch #(rx/of nil))
(rx/map #(vector (:url uri-data) %)))))
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
(rx/map #(create-svg-shapes (assoc svg-data :image-data %) position))))))
(defn create-svg-shapes
[svg-data {:keys [x y] :as position}]
(ptk/reify ::create-svg-shapes

5
frontend/src/app/main/ui/dashboard/import.cljs
View file

@ -17,6 +17,7 @@
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[potok.core :as ptk]
[rumext.alpha :as mf]))
@ -35,7 +36,7 @@
(mapv
(fn [file]
{:name (.-name file)
:uri (dom/create-uri file)})))]
:uri (wapi/create-uri file)})))]
(st/emit! (modal/show
{:type :import
:project-id project-id
@ -310,7 +311,7 @@
(fn []
;; dispose uris when the component is umount
#(doseq [file files]
(dom/revoke-uri (:uri file)))))
(wapi/revoke-uri (:uri file)))))
[:div.modal-overlay
[:div.modal-container.import-dialog

4
frontend/src/app/main/ui/onboarding/templates.cljs
View file

@ -12,9 +12,9 @@
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[rumext.alpha :as mf]))
@ -39,7 +39,7 @@
(reset! downloading? true)
(->> (http/send! {:method :get :uri link :response-type :blob :mode :no-cors})
(rx/subs (fn [{:keys [body] :as response}]
(open-import-modal {:name name :uri (dom/create-uri body)}))
(open-import-modal {:name name :uri (wapi/create-uri body)}))
(fn [error]
(js/console.log "error" error))
(fn []

49
frontend/src/app/main/ui/viewer/handoff/attributes/image.cljs
View file

@ -6,10 +6,11 @@
(ns app.main.ui.viewer.handoff.attributes.image
(:require
[app.config :as cfg]
[app.common.media :as cm]
[app.common.pages.helpers :as cph]
[app.config :as cf]
[app.main.ui.components.copy-button :refer [copy-button]]
[app.util.code-gen :as cg]
[app.util.dom :as dom]
[app.util.i18n :refer [tr]]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
@ -17,28 +18,28 @@
(defn has-image? [shape]
(= (:type shape) :image))
(mf/defc image-panel [{:keys [shapes]}]
(let [shapes (->> shapes (filter has-image?))]
(for [shape shapes]
[:div.attributes-block {:key (str "image-" (:id shape))}
[:div.attributes-image-row
[:div.attributes-image
[:img {:src (cfg/resolve-file-media (-> shape :metadata))}]]]
(mf/defc image-panel
[{:keys [shapes]}]
(for [shape (filter cph/image-shape? shapes)]
[:div.attributes-block {:key (str "image-" (:id shape))}
[:div.attributes-image-row
[:div.attributes-image
[:img {:src (cf/resolve-file-media (-> shape :metadata))}]]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (dom/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cfg/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])])))
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (cm/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cf/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])]))

5
frontend/src/app/main/ui/workspace/header.cljs
View file

@ -12,6 +12,7 @@
[app.main.data.exports :as de]
[app.main.data.modal :as modal]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.repo :as rp]
@ -111,10 +112,10 @@
frames (mf/deref refs/workspace-frames)
add-shared-fn
(st/emitf (dw/set-file-shared (:id file) true))
(st/emitf (dwl/set-file-shared (:id file) true))
del-shared-fn
(st/emitf (dw/set-file-shared (:id file) false))
(st/emitf (dwl/set-file-shared (:id file) false))
on-add-shared
(mf/use-fn

3
frontend/src/app/main/ui/workspace/left_toolbar.cljs
View file

@ -10,6 +10,7 @@
[app.common.media :as cm]
[app.main.data.events :as ev]
[app.main.data.workspace :as dw]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.store :as st]
@ -44,7 +45,7 @@
params {:file-id (:id file)
:blobs (seq blobs)
:position (gpt/point x y)}]
(st/emit! (dw/upload-media-workspace params)))))]
(st/emit! (dwm/upload-media-workspace params)))))]
[:li.tooltip.tooltip-right
{:alt (tr "workspace.toolbar.image" (sc/get-tooltip :insert-image))

7
frontend/src/app/main/ui/workspace/libraries.cljs
View file

@ -8,7 +8,6 @@
(:require
[app.common.data :as d]
[app.main.data.modal :as modal]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.refs :as refs]
[app.main.store :as st]
@ -72,13 +71,13 @@
(reset! search-term "")))
link-library
(mf/use-callback (mf/deps file) #(st/emit! (dw/link-file-to-library (:id file) %)))
(mf/use-callback (mf/deps file) #(st/emit! (dwl/link-file-to-library (:id file) %)))
unlink-library
(mf/use-callback
(mf/deps file)
(fn [library-id]
(st/emit! (dw/unlink-file-from-library (:id file) library-id)
(st/emit! (dwl/unlink-file-from-library (:id file) library-id)
(dwl/sync-file (:id file) library-id))))]
[:*
[:div.section
@ -164,7 +163,7 @@
(mf/deps project)
(fn []
(when (:team-id project)
(st/emit! (dw/fetch-shared-files {:team-id (:team-id project)})))))
(st/emit! (dwl/fetch-shared-files {:team-id (:team-id project)})))))
[:div.modal-overlay
[:div.modal.libraries-dialog

3
frontend/src/app/main/ui/workspace/sidebar/assets.cljs
View file

@ -18,6 +18,7 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.colors :as dc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.texts :as dwt]
[app.main.data.workspace.undo :as dwu]
@ -629,7 +630,7 @@
(fn [blobs]
(let [params {:file-id file-id
:blobs (seq blobs)}]
(st/emit! (dw/upload-media-asset params)
(st/emit! (dwm/upload-media-asset params)
(ptk/event ::ev/event {::ev/name "add-asset-to-library"
:asset-type "graphics"})))))

138
frontend/src/app/main/ui/workspace/viewport/actions.cljs
View file

@ -13,6 +13,7 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.drawing :as dd]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.path :as dwdp]
[app.main.store :as st]
[app.main.streams :as ms]
@ -423,82 +424,77 @@
(dnd/has-type? e "text/asset-id"))
(dom/prevent-default e)))))
(defn on-image-uploaded []
(mf/use-callback
(fn [image position]
(st/emit! (dw/image-uploaded image position)))))
(defn on-drop
[file viewport-ref zoom]
(mf/use-fn
(mf/deps zoom)
(fn [event]
(dom/prevent-default event)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(defn on-drop [file viewport-ref zoom]
(let [on-image-uploaded (on-image-uploaded)]
(mf/use-callback
(mf/deps zoom)
(fn [event]
(dom/prevent-default event)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dwm/upload-media-workspace params)))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dw/upload-media-workspace params)))
;; Will trigger when the user drags an SVG asset from the assets panel
(and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(st/emit! (dwm/upload-media-workspace params)))
;; Will trigger when the user drags an SVG asset from the assets panel
(and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(st/emit! (dw/upload-media-workspace params)))
;; Will trigger when the user drags an image from the assets SVG
(dnd/has-type? event "text/asset-id")
(let [params {:file-id (:id file)
:object-id asset-id
:name asset-name}]
(st/emit! (dwm/clone-media-object
(with-meta params
{:on-success #(st/emit! (dwm/image-uploaded % viewport-coord))}))))
;; Will trigger when the user drags an image from the assets SVG
(dnd/has-type? event "text/asset-id")
(let [params {:file-id (:id file)
:object-id asset-id
:name asset-name}]
(st/emit! (dw/clone-media-object
(with-meta params
{:on-success #(on-image-uploaded % viewport-coord)}))))
;; Will trigger when the user drags a file from their file explorer into the viewport
;; Or the user pastes an image
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dw/upload-media-workspace params)))))))))
;; Will trigger when the user drags a file from their file explorer into the viewport
;; Or the user pastes an image
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dwm/upload-media-workspace params))))))))
(defn on-paste [disable-paste in-viewport?]
(mf/use-callback

42
frontend/src/app/util/dom.cljs
View file

@ -10,8 +10,10 @@
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.common.media :as cm]
[app.util.globals :as globals]
[app.util.object :as obj]
[app.util.webapi :as wapi]
[cuerdas.core :as str]
[goog.dom :as dom]
[promesa.core :as p]))
@ -319,28 +321,11 @@
(log/error :msg "Seems like the current browser does not support fullscreen api.")
false)))
(defn ^boolean blob?
(defn blob?
[^js v]
(when (some? v)
(instance? js/Blob v)))
(defn create-blob
"Create a blob from content."
([content]
(create-blob content "application/octet-stream"))
([content mimetype]
(js/Blob. #js [content] #js {:type mimetype})))
(defn revoke-uri
[url]
(js/URL.revokeObjectURL url))
(defn create-uri
"Create a url from blob."
[b]
{:pre [(blob? b)]}
(js/URL.createObjectURL b))
(defn make-node
([namespace name]
(.createElementNS globals/document namespace name))
@ -432,21 +417,6 @@
(when (some? node)
(.getAttribute node (str "data-" attr))))
(defn mtype->extension [mtype]
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
(case mtype
"image/apng" ".apng"
"image/avif" ".avif"
"image/gif" ".gif"
"image/jpeg" ".jpg"
"image/png" ".png"
"image/svg+xml" ".svg"
"image/webp" ".webp"
"application/zip" ".zip"
"application/penpot" ".penpot"
"application/pdf" ".pdf"
nil))
(defn set-attribute! [^js node ^string attr value]
(when (some? node)
(.setAttribute node attr value)))
@ -497,7 +467,7 @@
(defn trigger-download-uri
[filename mtype uri]
(let [link (create-element "a")
extension (mtype->extension mtype)
extension (cm/mtype->extension mtype)
filename (if (and extension (not (str/ends-with? filename extension)))
(str/concat filename extension)
filename)]
@ -510,14 +480,14 @@
(defn trigger-download
[filename blob]
(trigger-download-uri filename (.-type ^js blob) (create-uri blob)))
(trigger-download-uri filename (.-type ^js blob) (wapi/create-uri blob)))
(defn save-as
[uri filename mtype description]
;; Only chrome supports the save dialog
(if (obj/contains? globals/window "showSaveFilePicker")
(let [extension (mtype->extension mtype)
(let [extension (cm/mtype->extension mtype)
opts {:suggestedName (str filename "." extension)
:types [{:description description
:accept { mtype [(str "." extension)]}}]}]

34
frontend/src/app/util/uri.cljs
View file

@ -1,34 +0,0 @@
;; 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.util.uri
(:require
[app.util.object :as obj]
[cuerdas.core :as str]))
(defn uri-name [url]
(let [query-idx (str/last-index-of url "?")
url (if (> query-idx 0) (subs url 0 query-idx) url)
filename (->> (str/split url "/") (last))
ext-idx (str/last-index-of filename ".")]
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn data-uri->blob
[data-uri]
(let [[mtype b64-data] (str/split data-uri ";base64,")
mtype (subs mtype (inc (str/index-of mtype ":")))
decoded (.atob js/window b64-data)
size (.-length decoded)
content (js/Uint8Array. size)]
(doseq [i (range 0 size)]
(obj/set! content i (.charCodeAt decoded i)))
(js/Blob. #js [content] #js {"type" mtype})))

2
frontend/src/app/util/webapi.cljs
View file

@ -37,7 +37,7 @@
[file]
(file-reader #(.readAsDataURL ^js %1 file)))
(defn ^boolean blob?
(defn blob?
[v]
(instance? js/Blob v))

7
frontend/src/app/worker/export.cljs
View file

@ -7,13 +7,14 @@
(ns app.worker.export
(:require
[app.common.data :as d]
[app.common.media :as cm]
[app.common.text :as ct]
[app.config :as cfg]
[app.main.render :as r]
[app.main.repo :as rp]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.json :as json]
[app.util.webapi :as wapi]
[app.util.zip :as uz]
[app.worker.impl :as impl]
[beicon.core :as rx]
@ -135,7 +136,7 @@
(rx/map #(assoc % :file-id file-id))
(rx/flat-map
(fn [media]
(let [file-path (str/concat file-id "/media/" (:id media) (dom/mtype->extension (:mtype media)))]
(let [file-path (str/concat file-id "/media/" (:id media) (cm/mtype->extension (:mtype media)))]
(->> (http/send!
{:uri (cfg/resolve-file-media media)
:response-type :blob
@ -466,7 +467,7 @@
:filename (:name file)
:mtype "application/penpot"
:description "Penpot export (*.penpot)"
:uri (dom/create-uri export-blob)}))))
:uri (wapi/create-uri export-blob)}))))
(rx/catch
(fn [err]
(rx/of {:type :error

4
frontend/src/app/worker/import.cljs
View file

@ -12,11 +12,11 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gpa]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.pages :as cp]
[app.common.text :as ct]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.import.parser :as cip]
[app.util.json :as json]
@ -49,7 +49,7 @@
:colors (str file-id "/colors.json")
:typographies (str file-id "/typographies.json")
:media-list (str file-id "/media.json")
:media (let [ext (dom/mtype->extension (:mtype media))]
:media (let [ext (cm/mtype->extension (:mtype media))]
(str/concat file-id "/media/" id ext))
:components (str file-id "/components.svg"))