Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-13 16:21:57 -05:00
Code Issues Activity

♻️ Integrate new storage subsystem.

Browse source
This commit is contained in:
Andrey Antukh 2021-01-04 18:41:05 +01:00 • committed by Alonso Torres
parent 3d88749976
commit ab944fb9ae
48 changed files with 950 additions and 632 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

135
backend/src/app/cli/migrate_media.clj Normal file
View file

@ -0,0 +1,135 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.cli.migrate-media
(:require
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.common.media :as cm]
[app.config :as cfg]
[app.db :as db]
[datoteka.core :as fs]
[app.main :as main]
[app.util.blob :as blob]
[app.storage :as sto]
[cuerdas.core :as str]
[clojure.tools.logging :as log]
[integrant.core :as ig]))
(declare migrate-profiles)
(declare migrate-teams)
(declare migrate-file-media)
(defn run-in-system
[system]
(db/with-atomic [conn (:app.db/pool system)]
(let [system (assoc system ::conn conn)]
(migrate-profiles system)
(migrate-teams system)
(migrate-file-media system))
system))
(defn run
[]
(let [config (select-keys (main/build-system-config cfg/config)
[:app.db/pool
:app.migrations/migrations
:app.metrics/metrics
:app.storage.s3/backend
:app.storage.db/backend
:app.storage.fs/backend
:app.storage/storage])]
(ig/load-namespaces config)
(try
(-> (ig/prep config)
(ig/init)
(run-in-system)
(ig/halt!))
(catch Exception e
(log/errorf e "Unhandled exception.")))))
;; --- IMPL
(defn migrate-profiles
[{:keys [::conn] :as system}]
(letfn [(retrieve-profiles [conn]
(->> (db/exec! conn ["select * from profile"])
(filter #(not (str/empty? (:photo %))))
(seq)))]
(let [base (fs/path (:storage-fs-old-directory cfg/config))
storage (-> (:app.storage/storage system)
(assoc :conn conn))]
(doseq [profile (retrieve-profiles conn)]
(let [path (fs/path (:photo profile))
full (-> (fs/join base path)
(fs/normalize))
ext (fs/ext path)
mtype (cm/format->mtype (keyword ext))
obj (sto/put-object storage {:content (sto/content full)
:content-type mtype})]
(db/update! conn :profile
{:photo-id (:id obj)}
{:id (:id profile)}))))))
(defn migrate-teams
[{:keys [::conn] :as system}]
(letfn [(retrieve-teams [conn]
(->> (db/exec! conn ["select * from team"])
(filter #(not (str/empty? (:photo %))))
(seq)))]
(let [base (fs/path (:storage-fs-old-directory cfg/config))
storage (-> (:app.storage/storage system)
(assoc :conn conn))]
(doseq [team (retrieve-teams conn)]
(let [path (fs/path (:photo team))
full (-> (fs/join base path)
(fs/normalize))
ext (fs/ext path)
mtype (cm/format->mtype (keyword ext))
obj (sto/put-object storage {:content (sto/content full)
:content-type mtype})]
(db/update! conn :team
{:photo-id (:id obj)}
{:id (:id team)}))))))
(defn migrate-file-media
[{:keys [::conn] :as system}]
(letfn [(retrieve-media-objects [conn]
(->> (db/exec! conn ["select fmo.id, fmo.path, fth.path as thumbnail_path
from file_media_object as fmo
join file_media_thumbnail as fth on (fth.media_object_id = fmo.id)"])
(seq)))]
(let [base (fs/path (:storage-fs-old-directory cfg/config))
storage (-> (:app.storage/storage system)
(assoc :conn conn))]
(doseq [mobj (retrieve-media-objects conn)]
(let [img-path (fs/path (:path mobj))
thm-path (fs/path (:thumbnail-path mobj))
img-path (-> (fs/join base img-path)
(fs/normalize))
thm-path (-> (fs/join base thm-path)
(fs/normalize))
img-ext (fs/ext img-path)
thm-ext (fs/ext thm-path)
img-mtype (cm/format->mtype (keyword img-ext))
thm-mtype (cm/format->mtype (keyword thm-ext))
img-obj (sto/put-object storage {:content (sto/content img-path)
:content-type img-mtype})
thm-obj (sto/put-object storage {:content (sto/content thm-path)
:content-type thm-mtype})]
(db/update! conn :file-media-object
{:media-id (:id img-obj)
:thumbnail-id (:id thm-obj)}
{:id (:id mobj)}))))))

21
backend/src/app/config.clj
View file

@ -24,15 +24,18 @@
:database-username "penpot"
:database-password "penpot"
:secret-key "default"
:enabled-asserts true
:asserts-enabled true
:public-uri "http://localhost:3449/"
:redis-uri "redis://localhost/0"
:storage-fs-directory "resources/public/media"
:storage-fs-uri "http://localhost:3449/media/"
:storage-fs-old-directory "resources/public/media"
:storage-fs-directory "resources/public/assets"
:storage-fs-uri "http://localhost:3449/internal/assets/"
:storage-s3-region :eu-central-1
:storage-s3-bucket "serenoxyztestbucket"
:image-process-max-threads 2
:smtp-enabled false
@ -50,12 +53,6 @@
:debug true
;; This is the time should transcurr after the last page
;; modification in order to make the file ellegible for
;; trimming. The value only supports s(econds) m(inutes) and
;; h(ours) as time unit.
:file-trimming-threshold "72h"
;; LDAP auth disabled by default. Set ldap-auth-host to enable
;:ldap-auth-host "ldap.mysupercompany.com"
;:ldap-auth-port 389
@ -87,7 +84,7 @@
(s/def ::media-uri ::us/string)
(s/def ::media-directory ::us/string)
(s/def ::secret-key ::us/string)
(s/def ::enable-asserts ::us/boolean)
(s/def ::asserts-enabled ::us/boolean)
(s/def ::host ::us/string)
(s/def ::error-report-webhook ::us/string)
@ -108,7 +105,6 @@
(s/def ::backend-uri ::us/string)
(s/def ::image-process-max-threads ::us/integer)
(s/def ::file-trimming-threshold ::dt/duration)
(s/def ::google-client-id ::us/string)
(s/def ::google-client-secret ::us/string)
@ -145,7 +141,7 @@
::gitlab-client-id
::gitlab-client-secret
::gitlab-base-uri
::enable-asserts
::asserts-enabled
::redis-uri
::public-uri
::database-username
@ -167,7 +163,6 @@
::smtp-tls
::smtp-ssl
::host
::file-trimming-threshold
::telemetry-enabled
::telemetry-server-enabled
::telemetry-uri

9
backend/src/app/http.clj
View file

@ -15,6 +15,7 @@
[app.http.auth :as auth]
[app.http.errors :as errors]
[app.http.middleware :as middleware]
[app.http.assets :as assets]
[app.metrics :as mtx]
[clojure.tools.logging :as log]
[integrant.core :as ig]
@ -91,7 +92,13 @@
[{:keys [session rpc google-auth gitlab-auth metrics ldap-auth storage] :as cfg}]
(rr/router
[["/metrics" {:get (:handler metrics)}]
["/storage/:id" {:get (:handler storage)}]
["/assets" {:middleware [[middleware/format-response-body]
[middleware/errors errors/handle]]}
["/by-id/:id" {:get #(assets/objects-handler storage %)}]
["/by-file-media-id/:id" {:get #(assets/file-objects-handler storage %)}]
["/by-file-media-id/:id/thumbnail" {:get #(assets/file-thumbnails-handler storage %)}]]
["/api" {:middleware [[middleware/format-response-body]
[middleware/parse-request-body]
[middleware/errors errors/handle]

87
backend/src/app/http/assets.clj Normal file
View file

@ -0,0 +1,87 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020-2021 UXBOX Labs SL
(ns app.http.assets
"Assets related handlers."
(:require
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.storage :as sto]
[app.db :as db]
[app.util.time :as dt]))
(def ^:private cache-max-age
(dt/duration {:hours 24}))
(def ^:private signature-max-age
(dt/duration {:hours 24 :minutes 15}))
(defn- generic-handler
[storage request id]
(if-let [obj (sto/get-object storage id)]
(let [mdata (meta obj)
backend (sto/resolve-backend storage (:backend obj))]
(case (:type backend)
:db
{:status 200
:headers {"content-type" (:content-type mdata)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body (sto/get-object-data storage obj)}
:s3
(let [url (sto/get-object-url storage obj {:max-age signature-max-age})]
{:status 307
:headers {"location" (str url)
"x-host" (:host url)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body ""})
:fs
(let [url (sto/get-object-url storage obj)]
{:status 200
:headers {"x-accel-redirect" (:path url)
"content-type" (:content-type mdata)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body ""})))
{:status 404
:body ""}))
(defn coerce-id
[id]
(let [res (us/uuid-conformer id)]
(when-not (uuid? res)
(ex/raise :type :not-found
:hint "object not found"))
res))
(defn- get-file-media-object
[conn id]
(let [id (coerce-id id)
mobj (db/exec-one! conn ["select * from file_media_object where id=?" id])]
(when-not mobj
(ex/raise :type :not-found
:hint "object does not found"))
mobj))
(defn objects-handler
[storage request]
(let [id (get-in request [:path-params :id])]
(generic-handler storage request (coerce-id id))))
(defn file-objects-handler
[{:keys [pool] :as storage} request]
(let [id (get-in request [:path-params :id])
mobj (get-file-media-object pool id)]
(generic-handler storage request (:media-id mobj))))
(defn file-thumbnails-handler
[{:keys [pool] :as storage} request]
(let [id (get-in request [:path-params :id])
mobj (get-file-media-object pool id)]
(generic-handler storage request (:thumbnail-id mobj))))

90
backend/src/app/main.clj
View file

@ -16,7 +16,7 @@
[integrant.core :as ig]))
;; Set value for all new threads bindings.
(alter-var-root #'*assert* (constantly (:enable-asserts cfg/config)))
(alter-var-root #'*assert* (constantly (:assets-enabled cfg/config)))
(derive :app.telemetry/server :app.http/server)
@ -24,7 +24,7 @@
(defn build-system-config
[config]
(merge
(d/deep-merge
{:app.db/pool
{:uri (:database-uri config)
:username (:database-username config)
@ -54,32 +54,13 @@
:app.tokens/tokens
{:secret-key (:secret-key config)}
:app.media-storage/storage
{:media-directory (:media-directory config)
:media-uri (:media-uri config)}
:app.storage/storage
{:pool (ig/ref :app.db/pool)
:backend (:storage-default-backend cfg/config :s3)
:backends {:s3 (ig/ref :app.storage.s3/backend)
:fs (ig/ref :app.storage.fs/backend)
:db (ig/ref :app.storage.db/backend)}}
:app.storage/gc-task
{:pool (ig/ref :app.db/pool)
:storage (ig/ref :app.storage/storage)}
:app.storage.fs/backend
{:directory (:storage-fs-directory cfg/config)
:uri (:storage-fs-uri cfg/config)}
:app.storage.db/backend
{:pool (ig/ref :app.db/pool)}
:app.storage.s3/backend
{:region (:storage-s3-region cfg/config)
:bucket (:storage-s3-bucket cfg/config)}
:app.storage/recheck-task
{:pool (ig/ref :app.db/pool)
:storage (ig/ref :app.storage/storage)}
:app.http.session/session
{:pool (ig/ref :app.db/pool)
@ -106,7 +87,7 @@
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:metrics (ig/ref :app.metrics/metrics)
:storage (ig/ref :app.media-storage/storage)
:storage (ig/ref :app.storage/storage)
:redis (ig/ref :app.redis/redis)}
:app.notifications/handler
@ -157,10 +138,9 @@
{:executor (ig/ref :app.worker/executor)
:pool (ig/ref :app.db/pool)
:schedule
[;; TODO: pending to refactor
;; {:id "file-media-gc"
;; :cron #app/cron "0 0 0 */1 * ? *" ;; daily
;; :fn (ig/ref :app.tasks.file-media-gc/handler)}
[{:id "file-media-gc"
:cron #app/cron "0 0 0 */1 * ? *" ;; daily
:fn (ig/ref :app.tasks.file-media-gc/handler)}
{:id "file-xlog-gc"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
@ -170,6 +150,10 @@
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn (ig/ref :app.storage/gc-task)}
{:id "storage-recheck"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn (ig/ref :app.storage/recheck-task)}
{:id "tasks-gc"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn (ig/ref :app.tasks.tasks-gc/handler)}
@ -185,14 +169,14 @@
"delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
:app.tasks.sendmail/handler
{:host (:smtp-host config)
:port (:smtp-port config)
:ssl (:smtp-ssl config)
:tls (:smtp-tls config)
:enabled (:smtp-enabled config)
:username (:smtp-username config)
:password (:smtp-password config)
:metrics (ig/ref :app.metrics/metrics)
{:host (:smtp-host config)
:port (:smtp-port config)
:ssl (:smtp-ssl config)
:tls (:smtp-tls config)
:enabled (:smtp-enabled config)
:username (:smtp-username config)
:password (:smtp-password config)
:metrics (ig/ref :app.metrics/metrics)
:default-reply-to (:smtp-default-reply-to config)
:default-from (:smtp-default-from config)}
@ -205,13 +189,20 @@
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.delete-storage-object/handler
{:pool (ig/ref :app.db/pool)
:storage (ig/ref :app.storage/storage)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.delete-profile/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.file-media-gc/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:metrics (ig/ref :app.metrics/metrics)
:storage (ig/ref :app.storage/storage)
:max-age (dt/duration {:hours 72})}
:app.tasks.file-xlog-gc/handler
{:pool (ig/ref :app.db/pool)
@ -228,7 +219,28 @@
:app.error-reporter/instance
{:uri (:error-report-webhook cfg/config)
:executor (ig/ref :app.worker/executor)}}
:executor (ig/ref :app.worker/executor)}
:app.storage/storage
{:pool (ig/ref :app.db/pool)
:executor (ig/ref :app.worker/executor)
:backends {:s3 (ig/ref :app.storage.s3/backend)
:fs (ig/ref :app.storage.fs/backend)
:db (ig/ref :app.storage.db/backend)}}
:app.storage.s3/backend
{:region (:storage-s3-region cfg/config)
:bucket (:storage-s3-bucket cfg/config)}
:app.storage.fs/backend
{:directory (:storage-fs-directory cfg/config)
:uri (:storage-fs-uri cfg/config)}
:app.storage.db/backend
{:pool (ig/ref :app.db/pool)}}
(let [backend (:storage-default-backend cfg/config :fs)]
{:app.storage/storage {:backend backend}})
(when (:telemetry-server-enabled cfg/config)
{:app.telemetry/handler

15
backend/src/app/media.clj
View file

@ -70,7 +70,7 @@
(let [{:keys [path mtype]} input
format (or (cm/mtype->format mtype) format)
ext (cm/format->extension format)
tmp (fs/create-tempfile :suffix ext)]
tmp (fs/create-tempfile :suffix ext)]
(doto (ConvertCmd.)
(.run operation (into-array (map str [path tmp]))))
@ -80,6 +80,7 @@
(assoc params
:format format
:mtype (cm/format->mtype format)
:size (alength thumbnail-data)
:data (ByteArrayInputStream. thumbnail-data)))))
(defmulti process :cmd)
@ -160,24 +161,18 @@
:code :media-type-not-allowed
:hint "Seems like you are uploading an invalid media object")))
;; TODO: rewrite using jetty http client instead of jvm
;; builtin (because builtin http client uses a lot of memory for the
;; same operation.
(defn download-media-object
[url]
(let [result (http/get! url {:as :byte-array})
data (:body result)
data (:body result)
content-type (get (:headers result) "content-type")
format (cm/mtype->format content-type)]
(if (nil? format)
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "Seems like the url points to an invalid media object.")
(let [tempfile (fs/create-tempfile)
base-filename (first (fs/split-ext (fs/name tempfile)))
filename (str base-filename (cm/format->extension format))]
(let [tempfile (fs/create-tempfile)
filename (fs/name tempfile)]
(with-open [ostream (io/output-stream tempfile)]
(.write ostream data))
{:filename filename

3
backend/src/app/migrations.clj
View file

@ -119,6 +119,9 @@
{:name "0035-add-storage-tables"
:fn (mg/resource "app/migrations/sql/0035-add-storage-tables.sql")}
{:name "0036-mod-storage-referenced-tables"
:fn (mg/resource "app/migrations/sql/0036-mod-storage-referenced-tables.sql")}
])

13
backend/src/app/migrations/sql/0035-add-storage-tables.sql
View file

@ -15,6 +15,19 @@ CREATE TABLE storage_data (
data bytea NOT NULL
);
-- Table used for store inflight upload ids, for later recheck and
-- delete possible staled files that exists on the phisical storage
-- but does not exists in the 'storage_object' table.
CREATE TABLE storage_pending (
id uuid NOT NULL,
backend text NOT NULL,
created_at timestamptz NOT NULL DEFAULT now(),
PRIMARY KEY (created_at, id)
);
CREATE INDEX storage_data__id__idx ON storage_data(id);
CREATE INDEX storage_object__id__deleted_at__idx
ON storage_object(id, deleted_at)

27
backend/src/app/migrations/sql/0036-mod-storage-referenced-tables.sql Normal file
View file

@ -0,0 +1,27 @@
-- Complete migration consists of:
-- - Move all file_media_objects and file_media_thumbnail to new storage.
-- - Replace the relative paths to the storage id's on all files/pages.
-- - Adapt frontend code to properly resolve url using the ids instead of paths.
-- Profile
ALTER TABLE profile ADD COLUMN photo_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL;
CREATE INDEX profile__photo_id__idx ON profile(photo_id);
-- Team
ALTER TABLE team ADD COLUMN photo_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL;
CREATE INDEX team__photo_id__idx ON team(photo_id);
-- Media Objects -> File Media Objects
ALTER TABLE media_object RENAME TO file_media_object;
ALTER TABLE media_thumbnail RENAME TO file_media_thumbnail;
ALTER TABLE file_media_object
ADD COLUMN media_id uuid NULL REFERENCES storage_object(id) ON DELETE CASCADE,
ADD COLUMN thumbnail_id uuid NULL REFERENCES storage_object(id) ON DELETE CASCADE;
CREATE INDEX file_media_object__image_id__idx ON file_media_object(media_id);
CREATE INDEX file_media_object__thumbnail_id__idx ON file_media_object(thumbnail_id);
ALTER TABLE file_media_object ALTER COLUMN path DROP NOT NULL;
ALTER TABLE profile ALTER COLUMN photo DROP NOT NULL;
ALTER TABLE team ALTER COLUMN photo DROP NOT NULL;

9
backend/src/app/migrations/sql/0037-mod-storage-related-tables.sql Normal file
View file

@ -0,0 +1,9 @@
--- This is a second migration but it should be applied when manual
--- migration intervention is alteady executed.
ALTER TABLE file_media_object ALTER COLUMN media_id SET NOT NULL;
DROP TABLE file_media_thumbnail;
ALTER TABLE team DROP COLUMN photo;
ALTER TABLE profile DROP COLUMN photo;
ALTER TABLE file_media_object DROP COLUMN path;

1
backend/src/app/rpc.clj
View file

@ -98,6 +98,7 @@
'app.rpc.mutations.comments
'app.rpc.mutations.projects
'app.rpc.mutations.viewer
'app.rpc.mutations.teams
'app.rpc.mutations.verify-token)
(map (partial process-method cfg))
(into {})))

168
backend/src/app/rpc/mutations/media.clj
View file

@ -5,7 +5,9 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
;; Copyright (c) 2020-2021 UXBOX Labs SL
;; TODO: move to file namespace, there are no media concept separated from file.
(ns app.rpc.mutations.media
(:require
@ -18,6 +20,7 @@
[app.rpc.queries.teams :as teams]
[app.util.storage :as ust]
[app.util.services :as sv]
[app.storage :as sto]
[clojure.spec.alpha :as s]
[datoteka.core :as fs]))
@ -32,81 +35,122 @@
(s/def ::profile-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::url ::us/url)
;; --- Create Media object (Upload and create from url)
;; --- Create File Media object (upload)
(declare create-media-object)
(declare create-file-media-object)
(declare select-file-for-update)
(declare persist-media-object-on-fs)
(declare persist-media-thumbnail-on-fs)
(s/def ::content ::media/upload)
(s/def ::is-local ::us/boolean)
(s/def ::add-media-object-from-url
(s/keys :req-un [::profile-id ::file-id ::is-local ::url]
:opt-un [::id ::name]))
(s/def ::upload-media-object
(s/def ::upload-file-media-object
(s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
:opt-un [::id]))
(sv/defmethod ::add-media-object-from-url
(sv/defmethod ::upload-file-media-object
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file))
(-> (assoc cfg :conn conn)
(create-file-media-object params)))))
(defn create-file-media-object
[{:keys [conn storage] :as cfg} {:keys [id file-id is-local name content] :as params}]
(media/validate-media-type (:content-type content))
(let [storage (assoc storage :conn conn)
source-path (fs/path (:tempfile content))
source-mtype (:content-type content)
source-info (media/run {:cmd :info :input {:path source-path :mtype source-mtype}})
thumb (when (not= (:mtype source-info) "image/svg+xml")
(media/run (assoc thumbnail-options
:cmd :generic-thumbnail
:input {:mtype (:mtype source-info) :path source-path})))
image (sto/put-object storage {:content (sto/content source-path)
:content-type (:mtype source-info)})
thumb (when thumb
(sto/put-object storage {:content (sto/content (:data thumb) (:size thumb))
:content-type (:mtype thumb)}))]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
:is-local is-local
:name name
:media-id (:id image)
:thumbnail-id (:id thumb)
:width (:width source-info)
:height (:height source-info)
:mtype (:mtype source-info)})))
;; --- Create File Media Object (from URL)
(s/def ::create-file-media-object-from-url
(s/keys :req-un [::profile-id ::file-id ::is-local ::url]
:opt-un [::id ::name]))
(sv/defmethod ::create-file-media-object-from-url
[{:keys [pool] :as cfg} {:keys [profile-id file-id url name] :as params}]
(db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file))
(let [content (media/download-media-object url)
cfg (assoc cfg :conn conn)
params' (merge params {:content content
:name (or name (:filename content))})]
(create-media-object cfg params')))))
(sv/defmethod ::upload-media-object
;; TODO: schedule to delete the tempfile created by media/download-media-object
(-> (assoc cfg :conn conn)
(create-file-media-object params'))))))
;; --- Clone File Media object (Upload and create from url)
(declare clone-file-media-object)
(s/def ::clone-file-media-object
(s/keys :req-un [::profile-id ::file-id ::is-local ::id]))
(sv/defmethod ::clone-file-media-object
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)
cfg (assoc cfg :conn conn)]
(let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file))
(create-media-object cfg params))))
(defn create-media-object
[{:keys [conn] :as cfg} {:keys [id file-id is-local name content]}]
(media/validate-media-type (:content-type content))
(let [info (media/run {:cmd :info :input {:path (:tempfile content)
:mtype (:content-type content)}})
path (persist-media-object-on-fs cfg content)
opts (assoc thumbnail-options
:input {:mtype (:mtype info)
:path path})
thumb (if-not (= (:mtype info) "image/svg+xml")
(persist-media-thumbnail-on-fs cfg opts)
(assoc info
:path path
:quality 0))
(-> (assoc cfg :conn conn)
(clone-file-media-object params)))))
id (or id (uuid/next))
(defn clone-file-media-object
[{:keys [conn storage] :as cfg} {:keys [id file-id is-local]}]
(let [mobj (db/get-by-id conn :file-media-object id)
media-object (db/insert! conn :media-object
{:id id
:file-id file-id
:is-local is-local
:name name
:path (str path)
:width (:width info)
:height (:height info)
:mtype (:mtype info)})
;; This makes the storage participate in the same transaction.
storage (assoc storage :conn conn)
media-thumbnail (db/insert! conn :media-thumbnail
{:id (uuid/next)
:media-object-id id
:path (str (:path thumb))
:width (:width thumb)
:height (:height thumb)
:quality (:quality thumb)
:mtype (:mtype thumb)})]
(assoc media-object :thumb-path (:path media-thumbnail))))
img-obj (sto/get-object storage (:media-id mobj))
thm-obj (when (:thumbnail-id mobj)
(sto/get-object storage (:thumbnail-id mobj)))
image (sto/clone-object storage img-obj)
thumb (when thm-obj
(sto/clone-object storage thm-obj))]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
:is-local is-local
:name (:name mobj)
:media-id (:id image)
:thumbnail-id (:id thumb)
:width (:width mobj)
:height (:height mobj)
:mtype (:mtype mobj)})))
;; --- HELPERS
(def ^:private sql:select-file-for-update
"select file.*,
@ -122,25 +166,3 @@
(when-not row
(ex/raise :type :not-found))
row))
(defn persist-media-object-on-fs
[{:keys [storage]} {:keys [filename tempfile]}]
(let [filename (fs/name filename)]
(ust/save! storage filename tempfile)))
(defn persist-media-thumbnail-on-fs
[{:keys [storage]} {:keys [input] :as params}]
(let [path (ust/lookup storage (:path input))
thumb (media/run
(-> params
(assoc :cmd :generic-thumbnail)
(update :input assoc :path path)))
name (str "thumbnail-"
(first (fs/split-ext (fs/name (:path input))))
(cm/format->extension (:format thumb)))
path (ust/save! storage name (:data thumb))]
(-> thumb
(dissoc :data :input)
(assoc :path path))))

21
backend/src/app/rpc/mutations/profile.clj
View file

@ -21,8 +21,9 @@
[app.rpc.mutations.teams :as teams]
[app.rpc.mutations.verify-token :refer [process-token]]
[app.rpc.queries.profile :as profile]
[app.util.services :as sv]
[app.storage :as sto]
[app.tasks :as tasks]
[app.util.services :as sv]
[app.util.time :as dt]
[buddy.hashers :as hashers]
[clojure.spec.alpha :as s]
@ -166,7 +167,6 @@
{:id id
:fullname fullname
:email (str/lower email)
:photo ""
:password password
:is-active active?
:is-demo demo?})))
@ -240,7 +240,6 @@
:fullname fullname
:email (str/lower email)
:is-active true
:photo ""
:password "!"
:is-demo false}))
@ -307,26 +306,26 @@
(s/keys :req-un [::profile-id ::file]))
(sv/defmethod ::update-profile-photo
[{:keys [pool] :as cfg} {:keys [profile-id file] :as params}]
[{:keys [pool storage] :as cfg} {:keys [profile-id file] :as params}]
(media/validate-media-type (:content-type file))
(db/with-atomic [conn pool]
(let [profile (db/get-by-id conn :profile profile-id)
_ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}})
photo (teams/upload-photo cfg params)]
photo (teams/upload-photo cfg params)
storage (assoc storage :conn conn)]
;; Schedule deletion of old photo
(when (and (string? (:photo profile))
(not (str/blank? (:photo profile))))
(tasks/submit! conn {:name "remove-media"
:props {:path (:photo profile)}}))
(when-let [id (:photo-id profile)]
(sto/del-object storage id))
;; Save new photo
(update-profile-photo conn profile-id photo))))
(defn- update-profile-photo
[conn profile-id path]
[conn profile-id sobj]
(db/update! conn :profile
{:photo (str path)}
{:photo-id (:id sobj)}
{:id profile-id})
nil)

31
backend/src/app/rpc/mutations/teams.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
;; Copyright (c) 2020-2021 UXBOX Labs SL
(ns app.rpc.mutations.teams
(:require
@ -17,13 +17,12 @@
[app.db :as db]
[app.emails :as emails]
[app.media :as media]
[app.media-storage :as mst]
[app.rpc.mutations.projects :as projects]
[app.rpc.queries.profile :as profile]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[app.storage :as sto]
[app.tasks :as tasks]
[app.util.storage :as ust]
[app.util.services :as sv]
[app.util.time :as dt]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]
@ -63,7 +62,6 @@
(db/insert! conn :team
{:id id
:name name
:photo ""
:is-default default?})))
(defn create-team-profile
@ -245,27 +243,25 @@
(s/keys :req-un [::profile-id ::team-id ::file]))
(sv/defmethod ::update-team-photo
[{:keys [pool] :as cfg} {:keys [profile-id file team-id] :as params}]
[{:keys [pool storage] :as cfg} {:keys [profile-id file team-id] :as params}]
(media/validate-media-type (:content-type file))
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(let [team (teams/retrieve-team conn profile-id team-id)
_ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}})
cfg (assoc cfg :conn conn)
photo (upload-photo cfg params)]
;; Schedule deletion of old photo
(when (and (string? (:photo team))
(not (str/blank? (:photo team))))
(tasks/submit! conn {:name "remove-media"
:props {:path (:photo team)}}))
(when-let [id (:photo-id team)]
(sto/del-object storage id))
;; Save new photo
(db/update! conn :team
{:photo (str photo)}
{:photo-id (:id photo)}
{:id team-id})
(assoc team :photo (str photo)))))
(assoc team :photo-id (:id photo)))))
(defn upload-photo
[{:keys [storage]} {:keys [file]}]
@ -279,9 +275,12 @@
:width 256
:height 256
:input {:path (fs/path (:tempfile file))
:mtype (:content-type file)}})
name (str prefix (cm/format->extension (:format thumb)))]
(ust/save! storage name (:data thumb))))
:mtype (:content-type file)}})]
(sto/put-object storage
{:content (sto/content (:data thumb) (:size thumb))
:content-type (:mtype thumb)})))
;; --- Mutation: Invite Member

3
backend/src/app/rpc/queries/teams.clj
View file

@ -119,7 +119,8 @@
p.id,
p.email,
p.fullname as name,
p.photo,
p.fullname as fullname,
p.photo_id,
p.is_active
from team_profile_rel as tp
join profile as p on (p.id = tp.profile_id)

229
backend/src/app/storage.clj
View file

@ -16,39 +16,39 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.storage.db :as sdb]
[app.storage.fs :as sfs]
[app.storage.impl :as impl]
[app.storage.s3 :as ss3]
[app.storage.db :as sdb]
[app.util.time :as dt]
[lambdaisland.uri :as u]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]))
[integrant.core :as ig]
[lambdaisland.uri :as u]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Storage Module State
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare handler)
(s/def ::backend ::us/keyword)
(s/def ::backends
(s/map-of ::us/keyword
(s/or :s3 ::ss3/backend
:fs ::sfs/backend
:db ::sdb/backend)))
(s/map-of ::us/keyword (s/or :s3 (s/nilable ::ss3/backend)
:fs (s/nilable ::sfs/backend)
:db (s/nilable ::sdb/backend))))
(defmethod ig/pre-init-spec ::storage [_]
(s/keys :req-un [::backend ::db/pool ::backends]))
(s/keys :req-un [::backend ::wrk/executor ::db/pool ::backends]))
(defmethod ig/prep-key ::storage
[_ {:keys [backends] :as cfg}]
(assoc cfg :backends (d/without-nils backends)))
(-> (d/without-nils cfg)
(assoc :backends (d/without-nils backends))))
(defmethod ig/init-key ::storage
[_ {:keys [backends] :as cfg}]
(assoc cfg :handler (partial handler cfg)))
[_ cfg]
cfg)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Database Objects
@ -63,25 +63,35 @@
returning *")
(defn- create-database-object
[conn backend {:keys [content] :as object}]
(let [id (uuid/next)
mdata (dissoc object :content)
result (db/exec-one! conn [sql:insert-storage-object id
(count content)
(name backend)
(db/tjson mdata)])]
(StorageObject. (:id result)
(:size result)
(:created-at result)
backend
mdata
nil)))
[{:keys [conn backend]} {:keys [content] :as object}]
(if (instance? StorageObject object)
(let [id (uuid/random)
mdata (meta object)
result (db/exec-one! conn [sql:insert-storage-object id
(:size object)
(name (:backend object))
(db/tjson mdata)])]
(assoc object
:id (:id result)
:created-at (:created-at result)))
(let [id (uuid/random)
mdata (dissoc object :content)
result (db/exec-one! conn [sql:insert-storage-object id
(count content)
(name backend)
(db/tjson mdata)])]
(StorageObject. (:id result)
(:size result)
(:created-at result)
backend
mdata
nil))))
(def ^:private sql:retrieve-storage-object
"select * from storage_object where id = ? and deleted_at is null")
(defn- retrieve-database-object
[conn id]
[{:keys [conn] :as storage} id]
(when-let [res (db/exec-one! conn [sql:retrieve-storage-object id])]
(let [mdata (some-> (:metadata res) (db/decode-transit-pgobject))]
(StorageObject. (:id res)
@ -95,107 +105,90 @@
"update storage_object set deleted_at=now() where id=? and deleted_at is null")
(defn- delete-database-object
[conn id]
[{:keys [conn] :as storage} id]
(let [result (db/exec-one! conn [sql:delete-storage-object id])]
(pos? (:next.jdbc/update-count result))))
(defn- register-recheck
[{:keys [pool] :as storage} backend id]
(db/insert! pool :storage-pending {:id id :backend (name backend)}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare resolve-backend)
(defn content-object
([data] (impl/content-object data nil))
([data size] (impl/content-object data size)))
(defn content
([data] (impl/content data nil))
([data size] (impl/content data size)))
(defn get-object
[{:keys [conn pool]} id]
(let [id (impl/coerce-id id)]
(retrieve-database-object (or conn pool) id)))
[{:keys [conn pool] :as storage} id]
(-> (assoc storage :conn (or conn pool))
(retrieve-database-object id)))
(defn put-object
[{:keys [pool conn backend] :as storage} {:keys [content] :as object}]
(us/assert impl/content-object? content)
(let [conn (or conn pool)
object (create-database-object conn backend object)]
[{:keys [pool conn backend executor] :as storage} {:keys [content] :as object}]
(us/assert impl/content? content)
(let [storage (assoc storage :conn (or conn pool))
object (create-database-object storage object)]
;; Schedule to execute in background; in an other transaction and
;; register the currently created storage object id for a later
;; recheck.
(px/run! executor #(register-recheck storage backend (:id object)))
;; Store the data finally on the underlying storage subsystem.
(-> (resolve-backend storage backend)
(assoc :conn conn)
(impl/put-object object content))
object))
(defn clone-object
[{:keys [pool conn executor] :as storage} object]
(let [storage (assoc storage :conn (or conn pool))
object* (create-database-object storage object)]
(with-open [input (-> (resolve-backend storage (:backend object))
(impl/get-object-data object))]
(-> (resolve-backend storage (:backend storage))
(impl/put-object object* (impl/content input (:size object))))
object*)))
(defn get-object-data
[{:keys [pool conn] :as storage} object]
(-> (resolve-backend storage (:backend object))
(assoc :conn (or conn pool))
(impl/get-object object)))
(-> (assoc storage :conn (or conn pool))
(resolve-backend (:backend object))
(impl/get-object-data object)))
(defn get-object-url
([storage object]
(get-object-url storage object nil))
([storage object options]
([{:keys [conn pool] :as storage} object options]
;; As this operation does not need the database connection, the
;; assoc of the conn to backend is ommited.
(-> (resolve-backend storage (:backend object))
(-> (assoc storage :conn (or conn pool))
(resolve-backend (:backend object))
(impl/get-object-url object options))))
(defn del-object
[{:keys [conn pool]} id]
(let [conn (or conn pool)]
(delete-database-object conn id)))
[{:keys [conn pool] :as storage} id]
(-> (assoc storage :conn (or conn pool))
(delete-database-object id)))
;; --- impl
(defn- resolve-backend
[storage backend]
(let [backend* (get-in storage [:backends backend])]
(when-not backend*
(defn resolve-backend
[{:keys [conn] :as storage} backend-id]
(us/assert some? conn)
(let [backend (get-in storage [:backends backend-id])]
(when-not backend
(ex/raise :type :internal
:code :backend-not-configured
:hint (str/fmt "backend '%s' not configured" backend)))
backend*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def cache-max-age
(dt/duration {:hours 24}))
(def signature-max-age
(dt/duration {:hours 24 :minutes 15}))
(defn- handler
[storage request]
(let [id (get-in request [:path-params :id])
obj (get-object storage id)]
(if obj
(let [mdata (meta obj)
backend (resolve-backend storage (:backend obj))]
(case (:type backend)
:db
{:status 200
:headers {"content-type" (:content-type mdata)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body (get-object-data storage obj)}
:s3
(let [url (get-object-url storage obj {:max-age signature-max-age})]
{:status 307
:headers {"location" (str url)
"x-host" (:host url)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body ""})
:fs
(let [url (get-object-url storage obj)]
{:status 200
:headers {"x-accel-redirect" (:path url)
"content-type" (:content-type mdata)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}
:body ""})))
{:status 404
:body ""})))
:hint (str/fmt "backend '%s' not configured" backend-id)))
(assoc backend :conn conn)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Garbage Collection Task
@ -241,3 +234,49 @@
returning *;")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Recheck Stalled Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare sql:retrieve-pending)
(declare sql:exists-storage-object)
(defmethod ig/pre-init-spec ::recheck-task [_]
(s/keys :req-un [::storage ::db/pool]))
(defmethod ig/init-key ::recheck-task
[_ {:keys [pool storage] :as cfg}]
(letfn [(retrieve-pending [conn]
(->> (db/exec! conn [sql:retrieve-pending])
(map (fn [{:keys [backend] :as row}]
(assoc row :backend (keyword backend))))
(seq)))
(exists-on-database? [conn id]
(:exists (db/exec-one! conn [sql:exists-storage-object id])))
(recheck-item [conn {:keys [id backend]}]
(when-not (exists-on-database? conn id)
(let [backend (resolve-backend storage backend)
backend (assoc backend :conn conn)]
(impl/del-objects-in-bulk backend [id]))))]
(fn [task]
(db/with-atomic [conn pool]
(loop [items (retrieve-pending conn)]
(when items
(run! (partial recheck-item conn) items)
(recur (retrieve-pending conn))))))))
(def sql:retrieve-pending
"with items_part as (
select s.id from storage_pending as s
order by s.created_at
limit 100
)
delete from storage_pending
where id in (select id from items_part)
returning *;")
(def sql:exists-storage-object
"select exists (select id from storage_object where id = ?) as exists")

2
backend/src/app/storage/db.clj
View file

@ -46,7 +46,7 @@
(db/insert! conn :storage-data {:id id :data data})
object))
(defmethod impl/get-object :db
(defmethod impl/get-object-data :db
[{:keys [conn] :as backend} {:keys [id] :as object}]
(let [result (db/exec-one! conn ["select data from storage_data where id=?" id])]
(ByteArrayInputStream. (:data result))))

22
backend/src/app/storage/fs.clj
View file

@ -9,6 +9,7 @@
(ns app.storage.fs
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
@ -16,6 +17,7 @@
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[cuerdas.core :as str]
[lambdaisland.uri :as u]
[integrant.core :as ig])
(:import
@ -48,20 +50,20 @@
(defmethod impl/put-object :fs
[backend {:keys [id] :as object} content]
(let [^Path base (fs/path (:directory backend))
^Path path (fs/path (impl/id->path id))
^Path full (.resolve base path)]
(when-not (fs/exists? (.getParent full))
(fs/create-dir (.getParent full)))
(let [base (fs/path (:directory backend))
path (fs/path (impl/id->path id))
full (fs/normalize (fs/join base path))]
(when-not (fs/exists? (fs/parent full))
(fs/create-dir (fs/parent full)))
(with-open [^InputStream src (io/input-stream content)
^OutputStream dst (io/output-stream full)]
(io/copy src dst))))
(defmethod impl/get-object :fs
(defmethod impl/get-object-data :fs
[backend {:keys [id] :as object}]
(let [^Path base (fs/path (:directory backend))
^Path path (fs/path (impl/id->path id))
^Path full (.resolve base path)]
^Path full (fs/normalize (fs/join base path))]
(when-not (fs/exists? full)
(ex/raise :type :internal
:code :filesystem-object-does-not-exists
@ -73,12 +75,14 @@
(let [uri (u/uri (:uri backend))]
(update uri :path
(fn [existing]
(str existing (impl/id->path id))))))
(if (str/ends-with? existing "/")
(str existing (impl/id->path id))
(str existing "/" (impl/id->path id)))))))
(defmethod impl/del-objects-in-bulk :fs
[backend ids]
(let [base (fs/path (:directory backend))]
(doseq [id ids]
(let [path (fs/path (impl/id->path id))
path (.resolve ^Path base ^Path path)]
path (fs/join base path)]
(Files/deleteIfExists ^Path path)))))

26
backend/src/app/storage/impl.clj
View file

@ -33,9 +33,9 @@
:code :invalid-storage-backend
:context cfg))
(defmulti get-object (fn [cfg _] (:type cfg)))
(defmulti get-object-data (fn [cfg _] (:type cfg)))
(defmethod get-object :default
(defmethod get-object-data :default
[cfg _]
(ex/raise :type :internal
:code :invalid-storage-backend
@ -90,7 +90,7 @@
(defprotocol IContentObject)
(defn- path->content-object
(defn- path->content
[path]
(let [size (Files/size path)]
(reify
@ -107,7 +107,7 @@
clojure.lang.Counted
(count [_] size))))
(defn string->content-object
(defn string->content
[^String v]
(let [data (.getBytes v "UTF-8")
bais (ByteArrayInputStream. ^bytes data)]
@ -127,7 +127,7 @@
(count [_]
(alength data)))))
(defn- input-stream->content-object
(defn- input-stream->content
[^InputStream is size]
(reify
IContentObject
@ -144,35 +144,35 @@
clojure.lang.Counted
(count [_] size)))
(defn content-object
([data] (content-object data nil))
(defn content
([data] (content data nil))
([data size]
(cond
(instance? java.nio.file.Path data)
(path->content-object data)
(path->content data)
(instance? java.io.File data)
(path->content-object (.toPath ^java.io.File data))
(path->content (.toPath ^java.io.File data))
(instance? String data)
(string->content-object data)
(string->content data)
(instance? InputStream data)
(do
(when-not size
(throw (UnsupportedOperationException. "size should be provided on InputStream")))
(input-stream->content-object data size))
(input-stream->content data size))
:else
(throw (UnsupportedOperationException. "type not supported")))))
(defn content-object?
(defn content?
[v]
(satisfies? IContentObject v))
(defn slurp-bytes
[content]
(us/assert content-object? content)
(us/assert content? content)
(with-open [input (io/input-stream content)
output (java.io.ByteArrayOutputStream. (count content))]
(io/copy input output)

45
backend/src/app/storage/s3.clj
View file

@ -10,6 +10,7 @@
(ns app.storage.s3
"Storage backends abstraction layer."
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
@ -23,20 +24,19 @@
java.io.InputStream
java.io.OutputStream
java.nio.file.Path
software.amazon.awssdk.core.sync.RequestBody
software.amazon.awssdk.regions.Region
software.amazon.awssdk.services.s3.S3Client
software.amazon.awssdk.services.s3.S3ClientBuilder
software.amazon.awssdk.core.sync.RequestBody
software.amazon.awssdk.services.s3.model.PutObjectRequest
software.amazon.awssdk.services.s3.model.GetObjectRequest
software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest
software.amazon.awssdk.services.s3.presigner.S3Presigner
software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
software.amazon.awssdk.services.s3.model.Delete
software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
software.amazon.awssdk.services.s3.model.DeleteObjectsResponse
software.amazon.awssdk.services.s3.model.GetObjectRequest
software.amazon.awssdk.services.s3.model.ObjectIdentifier
software.amazon.awssdk.services.s3.model.DeleteObjectsResponse))
software.amazon.awssdk.services.s3.model.PutObjectRequest
software.amazon.awssdk.services.s3.presigner.S3Presigner
software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest))
(declare put-object)
(declare get-object)
@ -49,9 +49,14 @@
(s/def ::region #{:eu-central-1})
(s/def ::bucket ::us/string)
(s/def ::prefix ::us/string)
(defmethod ig/pre-init-spec ::backend [_]
(s/keys :opt-un [::region ::bucket]))
(s/keys :opt-un [::region ::bucket ::prefix]))
(defmethod ig/prep-key ::backend
[_ cfg]
(merge {:prefix ""} (d/without-nils cfg)))
(defmethod ig/init-key ::backend
[_ cfg]
@ -70,7 +75,7 @@
(s/def ::client #(instance? S3Client %))
(s/def ::presigner #(instance? S3Presigner %))
(s/def ::backend
(s/keys :req-un [::region ::bucket ::client ::type ::presigner]))
(s/keys :req-un [::region ::bucket ::client ::type ::presigner ::prefix]))
;; --- API IMPL
@ -78,7 +83,7 @@
[backend object content]
(put-object backend object content))
(defmethod impl/get-object :s3
(defmethod impl/get-object-data :s3
[backend object]
(get-object backend object))
@ -110,8 +115,8 @@
(build)))
(defn- put-object
[{:keys [client bucket]} {:keys [id] :as object} content]
(let [path (impl/id->path id)
[{:keys [client bucket prefix]} {:keys [id] :as object} content]
(let [path (str prefix "-" (impl/id->path id))
mdata (meta object)
mtype (:content-type mdata "application/octet-stream")
request (.. (PutObjectRequest/builder)
@ -126,10 +131,10 @@
^RequestBody content)))
(defn- get-object
[{:keys [client bucket]} {:keys [id]}]
[{:keys [client bucket prefix]} {:keys [id]}]
(let [gor (.. (GetObjectRequest/builder)
(bucket bucket)
(key (impl/id->path id))
(key (str prefix "-" (impl/id->path id)))
(build))
obj (.getObject ^S3Client client gor)]
(io/input-stream obj)))
@ -138,11 +143,11 @@
(dt/duration {:minutes 10}))
(defn- get-object-url
[{:keys [presigner bucket]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
[{:keys [presigner bucket prefix]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
(us/assert dt/duration? max-age)
(let [gor (.. (GetObjectRequest/builder)
(bucket bucket)
(key (impl/id->path id))
(key (str prefix "-" (impl/id->path id)))
(build))
gopr (.. (GetObjectPresignRequest/builder)
(signatureDuration max-age)
@ -152,10 +157,10 @@
(u/uri (str (.url ^PresignedGetObjectRequest pgor)))))
(defn- del-object-in-bulk
[{:keys [bucket client]} ids]
[{:keys [bucket client prefix]} ids]
(let [oids (map (fn [id]
(.. (ObjectIdentifier/builder)
(key (impl/id->path id))
(key (str prefix "-" (impl/id->path id)))
(build)))
ids)
delc (.. (Delete/builder)

5
backend/src/app/tasks/delete_object.clj
View file

@ -57,8 +57,3 @@
[conn {:keys [id] :as props}]
(let [sql "delete from project where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))
(defmethod handle-deletion :media-object
[conn {:keys [id] :as props}]
(let [sql "delete from media_object where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))

56
backend/src/app/tasks/file_media_gc.clj
View file

@ -14,35 +14,43 @@
(:require
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.metrics :as mtx]
[app.storage :as sto]
[app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.time :as dt]
[integrant.core :as ig]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
[clojure.tools.logging :as log]
[integrant.core :as ig]))
(declare handler)
(declare retrieve-candidates)
(declare process-file)
(s/def ::storage some?)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool]))
(s/keys :req-un [::db/pool ::storage]))
(defmethod ig/init-key ::handler
[_ cfg]
(partial handler cfg))
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_file_media_gc_timing"
:help "file media garbage collection task timing"}
(mtx/instrument handler))))
(defn- handler
[{:keys [pool]} _]
[{:keys [pool] :as cfg} _]
(db/with-atomic [conn pool]
(loop []
(let [files (retrieve-candidates conn)]
(when (seq files)
(run! (partial process-file conn) files)
(recur))))))
(let [cfg (assoc cfg :conn conn)]
(loop []
(let [files (retrieve-candidates cfg)]
(when files
(run! (partial process-file cfg) files)
(recur)))))))
(defn- decode-row
[{:keys [data] :as row}]
@ -62,12 +70,12 @@
for update skip locked")
(defn- retrieve-candidates
[conn]
(let [threshold (:file-trimming-threshold cfg/config)
interval (db/interval threshold)]
[{:keys [conn max-age] :as cfg}]
(let [interval (db/interval max-age)]
(->> (db/exec! conn [sql:retrieve-candidates-chunk interval])
(map (fn [{:keys [age] :as row}]
(assoc row :age (dt/duration {:seconds age})))))))
(assoc row :age (dt/duration {:seconds age}))))
(seq))))
(def ^:private
collect-media-xf
@ -86,7 +94,7 @@
(into (keys (:media data)))))
(defn- process-file
[conn {:keys [id data age] :as file}]
[{:keys [conn storage] :as cfg} {:keys [id data age] :as file}]
(let [data (-> (blob/decode data)
(assoc :id id)
(pmg/migrate-data))
@ -103,15 +111,11 @@
{:id id})
(doseq [mobj unused]
(log/debugf "schduling object deletion: id='%s' path='%s' delay='%s'"
(:id mobj) (:path mobj) cfg/default-deletion-delay)
(tasks/submit! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :media-object}})
(log/debugf "deleting media object: id='%s' media-id='%s' thumb-id='%s'"
(:id mobj) (:media-id mobj) (:thumbnail-id mobj))
(sto/del-object storage (:media-id mobj))
(sto/del-object storage (:thumbnail-id mobj))
;; Mark object as deleted
(db/update! conn :media-object
{:deleted-at (dt/now)}
{:id id}))
(db/delete! conn :media-object {:id (:id mobj)}))
nil))

94
backend/src/app/tasks/remove_media.clj
View file

@ -1,94 +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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tasks.remove-media
"TODO: pending to be refactored together with the storage
subsystem."
(:require
[app.common.spec :as us]
[app.db :as db]
;; [app.media-storage :as mst]
;; [app.metrics :as mtx]
;; [app.util.storage :as ust]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task: Remove Media
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task responsible of explicit action of removing a media from file
;; system. Mainly used for profile photo change; when we really know
;; that the previous photo becomes unused.
;; (s/def ::path ::us/not-empty-string)
;; (s/def ::props
;; (s/keys :req-un [::path]))
;; (defn handler
;; [{:keys [props] :as task}]
;; (us/verify ::props props)
;; (when (ust/exists? mst/media-storage (:path props))
;; (ust/delete! mst/media-storage (:path props))
;; (log/debug "Media " (:path props) " removed.")))
;; (mtx/instrument-with-summary!
;; {:var #'handler
;; :id "tasks__remove_media"
;; :help "Timing of remove-media task."})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task: Trim Media Storage
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The main purpose of this task is analize the `pending_to_delete`
;; table. This table stores the references to the physical files on
;; the file system thanks to `handle_delete()` trigger.
;; Example:
;; (1) You delete an media-object. (2) This media object is marked as
;; deleted. (3) A task (`delete-object`) is scheduled for permanent
;; delete the object. - If that object stores media, the database
;; will execute the `handle_delete()` trigger which will place
;; filesystem paths into the `pendint_to_delete` table. (4) This
;; task (`remove-deleted-media`) permanently delete the file from the
;; filesystem when is executed (by scheduler).
;; (def ^:private
;; sql:retrieve-peding-to-delete
;; "with items_part as (
;; select i.id
;; from pending_to_delete as i
;; order by i.created_at
;; limit ?
;; for update skip locked
;; )
;; delete from pending_to_delete
;; where id in (select id from items_part)
;; returning *")
;; (defn trim-media-storage
;; [_task]
;; (letfn [(decode-row [{:keys [data] :as row}]
;; (cond-> row
;; (db/pgobject? data) (assoc :data (db/decode-json-pgobject data))))
;; (retrieve-items [conn]
;; (->> (db/exec! conn [sql:retrieve-peding-to-delete 10])
;; (map decode-row)
;; (map :data)))
;; (remove-media [rows]
;; (run! (fn [item]
;; (let [path (get item "path")]
;; (ust/delete! mst/media-storage path)))
;; rows))]
;; (loop []
;; (let [rows (retrieve-items db/pool)]
;; (when-not (empty? rows)
;; (remove-media rows)
;; (recur))))))

9
common/app/common/data.cljc
View file

@ -34,6 +34,15 @@
#?(:cljs (instance? lks/LinkedSet o)
:clj (instance? LinkedSet o)))
(defn deep-merge
([a b]
(if (map? a)
(merge-with deep-merge a b)
b))
([a b & rest]
(reduce deep-merge a (cons b rest))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Structures Manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

4
common/app/common/media.cljc
View file

@ -31,9 +31,11 @@
(case format
:png "image/png"
:jpeg "image/jpeg"
:jpg "image/jpeg"
:webp "image/webp"
:gif "image/gif"
:svg "image/svg+xml"))
:svg "image/svg+xml"
"application/octet-stream"))
(defn mtype->format
[mtype]

20
common/app/common/pages/spec.cljc
View file

@ -318,7 +318,7 @@
:internal.shape/blur]))
;; shapes-group is handled differently
;; shapes-group is handled differently
(s/def ::minimal-shape
(s/keys :req-un [::type ::name]
@ -348,33 +348,23 @@
:internal.color/gradient]))
(s/def :internal.media-object/name ::string)
(s/def :internal.media-object/path ::string)
(s/def :internal.media-object/width ::safe-integer)
(s/def :internal.media-object/height ::safe-integer)
(s/def :internal.media-object/mtype ::string)
(s/def :internal.media-object/thumb-path ::string)
(s/def :internal.media-object/thumb-width ::safe-integer)
(s/def :internal.media-object/thumb-height ::safe-integer)
(s/def :internal.media-object/thumb-mtype ::string)
(s/def ::media-object
(s/keys :req-un [::id ::name
:internal.media-object/name
:internal.media-object/path
(s/keys :req-un [::id
::name
:internal.media-object/width
:internal.media-object/height
:internal.media-object/mtype
:internal.media-object/thumb-path]))
:internal.media-object/mtype]))
(s/def ::media-object-update
(s/keys :req-un [::id]
:req-opt [::name
:internal.media-object/name
:internal.media-object/path
:internal.media-object/width
:internal.media-object/height
:internal.media-object/mtype
:internal.media-object/thumb-path]))
:internal.media-object/mtype]))
(s/def :internal.file/colors
(s/map-of ::uuid ::color))

2
common/app/common/spec.cljc
View file

@ -36,7 +36,7 @@
;; --- Conformers
(defn- uuid-conformer
(defn uuid-conformer
[v]
(if (uuid? v)
v

50
docker/devenv/files/nginx.conf
View file

@ -40,8 +40,7 @@ http {
'' close;
}
include /etc/nginx/sites-enabled/*;
# include /etc/nginx/sites-enabled/*;
server {
listen 3449 default_server;
@ -59,25 +58,8 @@ http {
resolver 8.8.8.8;
etag off;
location / {
root /home/penpot/penpot/frontend/resources/public;
add_header Cache-Control "no-cache, max-age=0";
}
location /api {
proxy_pass http://127.0.0.1:6060/api;
}
location /storage {
proxy_pass http://127.0.0.1:6060/storage;
recursive_error_pages on;
proxy_intercept_errors on;
error_page 301 302 307 = @handle_redirect;
}
location @handle_redirect {
set $redirect_uri "$upstream_http_location";
set $redirect_host "$upstream_http_x_host";
@ -85,15 +67,34 @@ http {
proxy_buffering off;
add_header x-internal-redirect "$redirect_uri";
add_header cache-control "$redirect_cache_control";
proxy_set_header Host "$redirect_host";
proxy_hide_header etag;
proxy_hide_header x-amz-id-2;
proxy_hide_header x-amz-request-id;
proxy_hide_header x-amz-meta-server-side-encryption;
proxy_hide_header x-amz-server-side-encryption;
proxy_pass $redirect_uri;
add_header x-internal-redirect "$redirect_uri";
add_header x-cache-control "$redirect_cache_control";
add_header cache-control "$redirect_cache_control";
}
location /assets {
proxy_pass http://127.0.0.1:6060/assets;
recursive_error_pages on;
proxy_intercept_errors on;
error_page 301 302 307 = @handle_redirect;
}
location /internal/assets {
internal;
alias /home/penpot/penpot/backend/resources/public/assets;
add_header x-accel-redirect "$upstream_http_x_accel_redirect";
}
location /api {
proxy_pass http://127.0.0.1:6060/api;
}
location /export {
@ -112,8 +113,9 @@ http {
proxy_pass http://127.0.0.1:6060/ws/notifications;
}
location /media {
alias /home/penpot/penpot/backend/resources/public/media;
location / {
root /home/penpot/penpot/frontend/resources/public;
add_header Cache-Control "no-cache, max-age=0";
}
}
}

29
frontend/src/app/config.cljs
View file

@ -15,6 +15,7 @@
[app.common.version :as v]
[app.util.object :as obj]
[app.util.dom :as dom]
[app.util.avatars :as avatars]
[cuerdas.core :as str]))
;; --- Auxiliar Functions
@ -72,7 +73,7 @@
(def worker-uri (obj/get global "appWorkerURI" "/js/worker.js"))
(def public-uri (or (obj/get global "appPublicURI")
(.-origin ^js js/location)))
(def media-uri (str public-uri "/media"))
(def media-uri (str public-uri "/assets"))
(def version (delay (parse-version global)))
(def target (delay (parse-target global)))
(def browser (delay (parse-browser)))
@ -85,7 +86,6 @@
;; --- Helper Functions
(defn ^boolean check-browser? [candidate]
(us/verify ::browser candidate)
(= candidate @browser))
@ -94,9 +94,22 @@
(us/verify ::platform candidate)
(= candidate @platform))
(defn resolve-media-path
[path]
(when path
(if (str/starts-with? path "data:")
path
(str media-uri "/" path))))
(defn resolve-profile-photo-url
[{:keys [photo-id fullname name] :as profile}]
(if (nil? photo-id)
(avatars/generate {:name (or fullname name)})
(str public-uri "/assets/by-id/" photo-id)))
(defn resolve-team-photo-url
[{:keys [photo-id name] :as team}]
(if (nil? photo-id)
(avatars/generate {:name name})
(str public-uri "/assets/by-id/" photo-id)))
(defn resolve-file-media
([media]
(resolve-file-media media false))
([{:keys [id] :as media} thumnail?]
(str public-uri "/assets/by-file-media-id/" id (when thumnail? "/thumbnail"))))

3
frontend/src/app/main/data/dashboard.cljs
View file

@ -74,14 +74,13 @@
(watch [_ state stream]
(let [profile (:profile state)]
(->> (rp/query :team params)
(rx/map #(avatars/assoc-avatar % :name))
(rx/map #(partial fetched %))))))))
(defn fetch-team-members
[{:keys [id] :as params}]
(us/assert ::us/uuid id)
(letfn [(fetched [members state]
(->> (map #(avatars/assoc-avatar % :name) members)
(->> members
(d/index-by :id)
(assoc-in state [:team-members id])))]
(ptk/reify ::fetch-team-members

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

@ -25,10 +25,24 @@
[cuerdas.core :as str]
[potok.core :as ptk]))
;; --- Predicates
(defn ^boolean file?
[o]
(instance? js/File o))
(defn ^boolean blob?
[o]
(instance? js/Blob o))
;; --- Specs
(s/def ::js-file #(instance? js/Blob %))
(s/def ::js-files (s/coll-of ::js-file))
(s/def ::blob blob?)
(s/def ::blobs (s/coll-of ::blob))
(s/def ::file file?)
(s/def ::files (s/coll-of ::file))
;; --- Utility functions

5
frontend/src/app/main/data/users.cljs
View file

@ -59,9 +59,6 @@
(update [_ state]
(assoc state :profile
(cond-> data
(empty? (:photo data))
(assoc :photo (avatars/generate {:name fullname}))
(nil? (:lang data))
(assoc :lang cfg/default-language)
@ -197,7 +194,7 @@
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(letfn [(fetched [users state]
(->> (map #(avatars/assoc-avatar % :fullname) users)
(->> users
(d/index-by :id)
(assoc state :users)))]
(ptk/reify ::fetch-team-users

3
frontend/src/app/main/data/viewer.cljs
View file

@ -116,8 +116,7 @@
ptk/UpdateEvent
(update [_ state]
(let [objects (:objects page)
frames (extract-frames objects)
users (map #(avatars/assoc-avatar % :fullname) users)]
frames (extract-frames objects)]
(assoc state
:viewer-libraries (d/index-by :id libraries)
:viewer-data {:project project

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

@ -1185,8 +1185,7 @@
(prepare-object [objects selected {:keys [type] :as obj}]
(let [obj (maybe-translate obj objects selected)]
(if (= type :image)
(let [path (get-in obj [:metadata :path])
url (cfg/resolve-media-path path)]
(let [url (cfg/resolve-file-media (:metadata obj))]
(->> (http/fetch-as-data-url url)
(rx/map #(assoc obj ::data %))
(rx/take 1)))
@ -1314,7 +1313,7 @@
(fn [blob]
{:name (:name imgpart)
:file-id file-id
:content (list blob (:file-name imgpart))
:content blob
:is-local true}))
(rx/mapcat #(rp/mutation! :upload-media-object %))
(rx/map (fn [media]
@ -1441,7 +1440,7 @@
(let [file-id (get-in state [:workspace-file :id])
params {:file-id file-id
:local? true
:js-files [image]}]
:data [image]}]
(rx/of (dwp/upload-media-objects
(with-meta params
{:on-success image-uploaded})))))))
@ -1560,6 +1559,7 @@
(d/export dwp/link-file-to-library)
(d/export dwp/unlink-file-from-library)
(d/export dwp/upload-media-objects)
(d/export dwp/clone-media-object)
;; Selection

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

@ -12,6 +12,7 @@
[app.common.data :as d]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.common.pages :as cp]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.main.data.messages :as dm]
@ -109,8 +110,9 @@
(ptk/reify ::add-media
ptk/WatchEvent
(watch [_ state stream]
(let [rchg {:type :add-media
:object media}
(let [obj (select-keys media [:id :name :width :height :mtype])
rchg {:type :add-media
:object obj}
uchg {:type :del-media
:id id}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
@ -370,7 +372,7 @@
update-new-shape
(fn [new-shape original-shape]
(let [new-name
(let [new-name
(dwc/generate-unique-name @unames (:name new-shape))]
(swap! unames conj new-name)

3
frontend/src/app/main/data/workspace/notifications.cljs
View file

@ -147,8 +147,7 @@
(let [session {:id id
:fullname (:fullname profile)
:updated-at (dt/now)
:photo-uri (or (and (:photo profile) (cfg/resolve-media-path (:photo profile)))
(avatars/generate {:name (:fullname profile)}))}
:photo-uri (cfg/resolve-profile-photo-url profile)}
session (assign-color sessions session)]
(assoc sessions id session)))

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

@ -239,14 +239,13 @@
ptk/UpdateEvent
(update [_ state]
(let [users (map avatars/assoc-profile-avatar users)]
(assoc state
:users (d/index-by :id users)
:workspace-undo {}
:workspace-project project
:workspace-file file
:workspace-data (:data file)
:workspace-libraries (d/index-by :id libraries))))))
(assoc state
:users (d/index-by :id users)
:workspace-undo {}
:workspace-project project
:workspace-file file
:workspace-data (:data file)
:workspace-libraries (d/index-by :id libraries)))))
;; --- Set File shared
@ -339,70 +338,108 @@
(assoc-in state [:workspace-pages id] page))))
;; --- Upload local media objects
;; --- Upload File Media objects
(s/def ::local? ::us/boolean)
(s/def ::uri ::us/string)
(s/def ::data ::di/blobs)
(s/def ::name ::us/string)
(s/def ::uri ::us/string)
(s/def ::uris (s/coll-of ::uri))
(s/def ::upload-media-objects-params
(s/keys :req-un [::file-id ::local?]
:opt-un [::uri ::di/js-files]))
(s/def ::upload-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-in [::name ::data ::uris])
(fn [props]
(or (contains? props :data)
(contains? props :uris)))))
(defn upload-media-objects
[{:keys [file-id local? js-files uri name] :as params}]
(us/assert ::upload-media-objects-params params)
(ptk/reify ::upload-media-objects
[{:keys [file-id local? data name uris] :as params}]
(us/assert ::upload-media-objects params)
(ptk/reify ::upload-media-objects
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [on-success on-error]
:or {on-success identity}} (meta params)
prepare-file
(fn [blob]
(let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
{:name name
:file-id file-id
:content blob
:is-local local?}))
prepare-uri
(fn [uri]
{:file-id file-id
:is-local local?
:url uri
:name name})]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
(->> (rx/from uris)
(rx/map prepare-uri)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %)))
(->> (rx/from data)
(rx/map di/validate-file)
(rx/map prepare-file)
(rx/mapcat #(rp/mutation! :upload-file-media-object %))))
(rx/do on-success)
(rx/catch (fn [error]
(cond
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(fn? on-error)
(do
(on-error error)
(rx/empty))
:else
(rx/throw error))))
(rx/finalize (fn []
(st/emit! (dm/hide-tag :media-loading))))))))))
;; --- Upload File Media objects
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::local? ::object-id]))
(defn clone-media-object
[{:keys [file-id local? object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [on-success on-error]
:or {on-success identity}} (meta params)
is-library (not= file-id (:id (:workspace-file state)))
prepare-js-file
(fn [js-file]
{:name (.-name js-file)
:file-id file-id
:content js-file
:is-local local?})
prepare-uri
(fn [uri]
{:file-id file-id
:is-local local?
:url uri
:name name})]
:or {on-success identity
on-error identity}} (meta params)
params {:is-local local?
:file-id file-id
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (string? uri)
(->> (rx/of uri)
(rx/map prepare-uri)
(rx/mapcat #(rp/mutation! :add-media-object-from-url %)))
(->> (rx/from js-files)
(rx/map di/validate-file)
(rx/map prepare-js-file)
(rx/mapcat #(rp/mutation! :upload-media-object %))))
(->> (rp/mutation! :clone-file-media-object params)
(rx/do on-success)
(rx/catch (fn [error]
(cond
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(fn? on-error)
(do
(on-error error)
(rx/empty))
:else
(rx/throw error))))
(rx/finalize (fn []
(st/emit! (dm/hide-tag :media-loading))))))))))
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
;; --- Helpers

2
frontend/src/app/main/repo.cljs
View file

@ -91,7 +91,7 @@
(->> (http/send! {:method :post :uri uri})
(rx/mapcat handle-response))))
(defmethod mutation :upload-media-object
(defmethod mutation :upload-file-media-object
[id params]
(let [form (js/FormData.)]
(run! (fn [[key val]]

4
frontend/src/app/main/ui/comments.cljs
View file

@ -248,7 +248,7 @@
[:div.comment
[:div.author
[:div.avatar
[:img {:src (cfg/resolve-media-path (:photo owner))}]]
[:img {:src (cfg/resolve-profile-photo-url owner)}]]
[:div.name
[:div.fullname (:fullname owner)]
[:div.timeago (dt/timeago (:modified-at comment))]]
@ -366,7 +366,7 @@
:unread (pos? (:count-unread-comments item)))}
(:seqn item)]
[:div.avatar
[:img {:src (cfg/resolve-media-path (:photo owner))}]]
[:img {:src (cfg/resolve-profile-photo-url owner)}]]
[:div.name
[:div.fullname (:fullname owner) ", "]
[:div.timeago (dt/timeago (:modified-at item))]]]

8
frontend/src/app/main/ui/dashboard/sidebar.cljs
View file

@ -136,8 +136,6 @@
(mf/deps (:id team))
(fn []
(->> (rp/query! :teams)
(rx/map (fn [teams]
(mapv #(avatars/assoc-avatar % :name) teams)))
(rx/subs #(reset! teams %)))))
[:ul.dropdown.teams-dropdown
@ -151,7 +149,7 @@
[:* {:key (:id team)}
[:li.team-name {:on-click (partial go-projects (:id team))}
[:span.team-icon
[:img {:src (cfg/resolve-media-path (:photo team))}]]
[:img {:src (cfg/resolve-team-photo-url team)}]]
[:span.team-text {:title (:name team)} (:name team)]]])
[:hr]
@ -329,7 +327,7 @@
[:span.team-text (t locale "dashboard.default-team-name")]]
[:div.team-name
[:span.team-icon
[:img {:src (cfg/resolve-media-path (:photo team))}]]
[:img {:src (cfg/resolve-team-photo-url team)}]]
[:span.team-text {:title (:name team)} (:name team)]])
[:span.switch-icon
@ -427,7 +425,7 @@
(mf/defc profile-section
[{:keys [profile locale team] :as props}]
(let [show (mf/use-state false)
photo (cfg/resolve-media-path (:photo profile))
photo (cfg/resolve-profile-photo-url profile)
on-click
(mf/use-callback

4
frontend/src/app/main/ui/dashboard/team.cljs
View file

@ -283,7 +283,7 @@
[:div.name (:name team)]
[:div.icon
[:span.update-overlay {:on-click on-image-click} i/exit]
[:img {:src (cfg/resolve-media-path (:photo team))}]
[:img {:src (cfg/resolve-team-photo-url team)}]
[:& file-uploader {:accept "image/jpeg,image/png"
:multi false
:input-ref finput
@ -292,7 +292,7 @@
[:div.block.owner-block
[:div.label (tr "dashboard.team-members")]
[:div.owner
[:span.icon [:img {:src (cfg/resolve-media-path (:photo owner))}]]
[:span.icon [:img {:src (cfg/resolve-profile-photo-url owner)}]]
[:span.text (str (:name owner) " (" (tr "labels.owner") ")") ]]
[:div.summary
[:span.icon i/user]

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

@ -26,7 +26,7 @@
[:div.attributes-block {:key (str "image-" (:id shape))}
[:div.attributes-image-row
[:div.attributes-image
[:img {:src (cfg/resolve-media-path (-> shape :metadata :path))}]]]
[:img {:src (cfg/resolve-file-media (-> shape :metadata))}]]]
[:div.attributes-unit-row
[:div.attributes-label (t locale "handoff.attributes.image.width")]
@ -41,5 +41,5 @@
(let [filename (last (str/split (-> shape :metadata :path) "/"))]
[:a.download-button {:target "_blank"
:download filename
:href (cfg/resolve-media-path (-> shape :metadata :path))}
:href (cfg/resolve-file-media (-> shape :metadata))}
(t locale "handoff.attributes.image.download")])])))

7
frontend/src/app/main/ui/settings/profile.cljs
View file

@ -9,6 +9,7 @@
(ns app.main.ui.settings.profile
(:require
[app.config :as cfg]
[app.common.spec :as us]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
@ -91,11 +92,7 @@
[{:keys [locale] :as props}]
(let [file-input (mf/use-ref nil)
profile (mf/deref refs/profile)
photo (:photo profile)
photo (if (or (str/empty? photo) (nil? photo))
"images/avatar.jpg"
(cfg/resolve-media-path photo))
photo (cfg/resolve-profile-photo-url profile)
on-image-click #(dom/click (mf/ref-val file-input))
on-file-selected

4
frontend/src/app/main/ui/shapes/image.cljs
View file

@ -24,9 +24,9 @@
(let [shape (unchecked-get props "shape")
{:keys [id x y width height rotation metadata]} shape
uri (cfg/resolve-media-path (:path metadata))
uri (cfg/resolve-file-media metadata)
embed-resources? (mf/use-ctx muc/embed-ctx)
data-uri (mf/use-state (when (not embed-resources?) uri))]
data-uri (mf/use-state (when (not embed-resources?) uri))]
(mf/use-effect
(mf/deps uri)

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

@ -31,25 +31,25 @@
on-uploaded
(mf/use-callback
(fn [{:keys [id name] :as image}]
(let [shape {:name name
:width (:width image)
:height (:height image)
:metadata {:width (:width image)
:height (:height image)
:id (:id image)
:path (:path image)}}
aspect-ratio (/ (:width image) (:height image))]
(st/emit! (dw/create-and-add-shape :image 0 0 shape)))))
(fn [image]
(->> {:name (:name image)
:width (:width image)
:height (:height image)
:metadata {:width (:width image)
:height (:height image)
:mtype (:mtype image)
:id (:id image)}}
(dw/create-and-add-shape :image 0 0)
(st/emit!))))
on-files-selected
(mf/use-callback
(mf/deps file)
(fn [js-files]
(fn [blobs]
(st/emit! (dw/upload-media-objects
(with-meta {:file-id (:id file)
:local? true
:js-files js-files}
:data (seq blobs)}
{:on-success on-uploaded})))))]
[:li.tooltip.tooltip-right

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

@ -163,10 +163,10 @@
on-selected
(mf/use-callback
(mf/deps file-id)
(fn [js-files]
(fn [blobs]
(let [params (with-meta {:file-id file-id
:local? false
:js-files js-files}
:data (seq blobs)}
{:on-success on-media-uploaded})]
(st/emit! (dw/upload-media-objects params)))))
@ -212,8 +212,8 @@
on-drag-start
(mf/use-callback
(fn [path name event]
(dnd/set-data! event "text/uri-list" (cfg/resolve-media-path path))
(fn [{:keys [name id]} event]
(dnd/set-data! event "text/asset-id" (str id))
(dnd/set-data! event "text/asset-name" name)
(dnd/set-allowed-effect! event "move")))]
@ -234,8 +234,8 @@
[:div.grid-cell {:key (:id object)
:draggable true
:on-context-menu (on-context-menu (:id object))
:on-drag-start (partial on-drag-start (:path object) (:name object))}
[:img {:src (cfg/resolve-media-path (:thumb-path object))
:on-drag-start (partial on-drag-start object)}
[:img {:src (cfg/resolve-file-media object true)
:draggable false}] ;; Also need to add css pointer-events: none
#_[:div.cell-name (:name object)]

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

@ -46,6 +46,7 @@
[app.util.object :as obj]
[app.util.perf :as perf]
[app.util.timers :as timers]
[app.util.http :as http]
[beicon.core :as rx]
[clojure.set :as set]
[cuerdas.core :as str]
@ -437,7 +438,8 @@
(when (or (dnd/has-type? e "app/shape")
(dnd/has-type? e "app/component")
(dnd/has-type? e "Files")
(dnd/has-type? e "text/uri-list"))
(dnd/has-type? e "text/uri-list")
(dnd/has-type? e "text/asset-id"))
(dom/prevent-default e))))
on-drag-over
@ -446,24 +448,24 @@
(when (or (dnd/has-type? e "app/shape")
(dnd/has-type? e "app/component")
(dnd/has-type? e "Files")
(dnd/has-type? e "text/uri-list"))
(dnd/has-type? e "text/uri-list")
(dnd/has-type? e "text/asset-id"))
(dom/prevent-default e))))
;; TODO: seems duplicated callback is the same as one located
;; in left_toolbar
on-uploaded
(mf/use-callback
(fn [{:keys [id name] :as image} {:keys [x y]}]
(let [shape {:name name
:width (:width image)
:height (:height image)
:x (- x (/ (:width image) 2))
:y (- y (/ (:height image) 2))
:metadata {:width (:width image)
(fn [image {:keys [x y]}]
(prn "on-uploaded" image x y)
(let [shape {:name (:name image)
:width (:width image)
:height (:height image)
:x (- x (/ (:width image) 2))
:y (- y (/ (:height image) 2))
:metadata {:width (:width image)
:height (:height image)
:id (:id image)
:path (:path image)}}
aspect-ratio (/ (:width image) (:height image))]
:name (:name image)
:id (:id image)
:mtype (:mtype image)}}]
(st/emit! (dw/create-and-add-shape :image x y shape)))))
on-drop
@ -492,28 +494,36 @@
(gpt/point final-x final-y))))
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
name (dnd/get-data event "text/asset-name")
(let [data (dnd/get-data event "text/uri-list")
name (dnd/get-data event "text/asset-name")
lines (str/lines data)
urls (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)]
(->> urls
(map (fn [uri]
(with-meta {:file-id (:id file)
:local? true
:uri uri
:name name}
{:on-success #(on-uploaded % viewport-coord)})))
(map dw/upload-media-objects)
(apply st/emit!)))
urls (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)]
(st/emit!
(dw/upload-media-objects
(with-meta {:file-id (:id file)
:local? true
:uris urls
:name name}
{:on-success #(on-uploaded % viewport-coord)}))))
(dnd/has-type? event "text/asset-id")
(let [id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
name (dnd/get-data event "text/asset-name")
params {:file-id (:id file)
:local? true
:object-id id
:name name}]
(st/emit! (dw/clone-media-object
(with-meta params
{:on-success #(on-uploaded % viewport-coord)}))))
:else
(let [js-files (dnd/get-files event)
params {:file-id (:id file)
:local? true
:js-files js-files
}]
(let [files (dnd/get-files event)
params {:file-id (:id file)
:local? true
:data (seq files)}]
(st/emit! (dw/upload-media-objects
(with-meta params
{:on-success #(on-uploaded % viewport-coord)}))))))))

12
frontend/src/app/util/avatars.cljs
View file

@ -13,7 +13,7 @@
[app.util.object :as obj]
["randomcolor" :as rdcolor]))
(defn generate
(defn generate*
[{:keys [name color size]
:or {color "#000000" size 128}}]
(let [parts (str/words (str/upper name))
@ -36,13 +36,5 @@
(.toDataURL canvas)))
(defn assoc-avatar
[{:keys [photo] :as object} key]
(cond-> object
(or (nil? photo) (empty? photo))
(assoc :photo (generate {:name (get object key)}))))
(defn assoc-profile-avatar
[object]
(assoc-avatar object :fullname))
(def generate (memoize generate*))