3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-08-01 09:18:21 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #2743 from penpot/niwinz-enhancements-2

Browse source 
🐛 Bugfixes
This commit is contained in:
Alejandro 2023-01-10 09:56:45 +01:00 • committed by GitHub
commit b132837432
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
29 changed files with 756 additions and 547 deletions
Download patch file Download diff file Expand all files Collapse all files

36
backend/src/app/auth/ldap.clj
View file

@ -41,15 +41,18 @@
(reduce-kv clojure.string/replace s replacements)) (reduce-kv clojure.string/replace s replacements))
(defn- search-user (defn- search-user
[{:keys [conn attrs base-dn] :as cfg} email] [{:keys [::conn base-dn] :as cfg} email]
(let [query (replace-several (:query cfg) ":username" email) (let [query (replace-several (:query cfg) ":username" email)
attrs [(:attrs-username cfg)
(:attrs-email cfg)
(:attrs-fullname cfg)]
params {:filter query params {:filter query
:sizelimit 1 :sizelimit 1
:attributes attrs}] :attributes attrs}]
(first (ldap/search conn base-dn params)))) (first (ldap/search conn base-dn params))))
(defn- retrieve-user (defn- retrieve-user
[{:keys [conn] :as cfg} {:keys [email password]}] [{:keys [::conn] :as cfg} {:keys [email password]}]
(when-let [{:keys [dn] :as user} (search-user cfg email)] (when-let [{:keys [dn] :as user} (search-user cfg email)]
(when (ldap/bind? conn dn password) (when (ldap/bind? conn dn password)
{:fullname (get user (-> cfg :attrs-fullname keyword)) {:fullname (get user (-> cfg :attrs-fullname keyword))
@ -66,7 +69,7 @@
(defn authenticate (defn authenticate
[cfg params] [cfg params]
(with-open [conn (connect cfg)] (with-open [conn (connect cfg)]
(when-let [user (-> (assoc cfg :conn conn) (when-let [user (-> (assoc cfg ::conn conn)
(retrieve-user params))] (retrieve-user params))]
(when-not (s/valid? ::info-data user) (when-not (s/valid? ::info-data user)
(let [explain (s/explain-str ::info-data user)] (let [explain (s/explain-str ::info-data user)]
@ -100,17 +103,6 @@
:host (:host cfg) :port (:port cfg) :cause cause) :host (:host cfg) :port (:port cfg) :cause cause)
nil)))) nil))))
(defn- prepare-attributes
[cfg]
(assoc cfg :attrs [(:attrs-username cfg)
(:attrs-email cfg)
(:attrs-fullname cfg)]))
(defmethod ig/init-key ::provider
[_ cfg]
(when (:enabled? cfg)
(some-> cfg try-connectivity prepare-attributes)))
(s/def ::enabled? ::us/boolean) (s/def ::enabled? ::us/boolean)
(s/def ::host ::cf/ldap-host) (s/def ::host ::cf/ldap-host)
(s/def ::port ::cf/ldap-port) (s/def ::port ::cf/ldap-port)
@ -124,8 +116,7 @@
(s/def ::attrs-fullname ::cf/ldap-attrs-fullname) (s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
(s/def ::attrs-username ::cf/ldap-attrs-username) (s/def ::attrs-username ::cf/ldap-attrs-username)
(defmethod ig/pre-init-spec ::provider (s/def ::provider-params
[_]
(s/keys :opt-un [::host ::port (s/keys :opt-un [::host ::port
::ssl ::tls ::ssl ::tls
::enabled? ::enabled?
@ -135,3 +126,14 @@
::attrs-email ::attrs-email
::attrs-username ::attrs-username
::attrs-fullname])) ::attrs-fullname]))
(s/def ::provider
(s/nilable ::provider-params))
(defmethod ig/pre-init-spec ::provider
[_]
(s/spec ::provider))
(defmethod ig/init-key ::provider
[_ cfg]
(when (:enabled? cfg)
(try-connectivity cfg)))

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

@ -61,7 +61,7 @@
:public-uri "http://localhost:3449" :public-uri "http://localhost:3449"
:host "localhost" :host "localhost"
:tenant "main" :tenant "default"
:redis-uri "redis://redis/0" :redis-uri "redis://redis/0"
:srepl-host "127.0.0.1" :srepl-host "127.0.0.1"

16
backend/src/app/loggers/audit.clj
View file

@ -8,6 +8,7 @@
"Services related to the user activity (audit log)." "Services related to the user activity (audit log)."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
@ -20,6 +21,7 @@
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.main :as-alias main] [app.main :as-alias main]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.rpc :as-alias rpc]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.retry :as rtry] [app.util.retry :as rtry]
[app.util.time :as dt] [app.util.time :as dt]
@ -171,18 +173,20 @@
(::webhooks/event? event)) (::webhooks/event? event))
(let [batch-key (::webhooks/batch-key event) (let [batch-key (::webhooks/batch-key event)
batch-timeout (::webhooks/batch-timeout event) batch-timeout (::webhooks/batch-timeout event)
label-suffix (when (ifn? batch-key) label (dm/str "rpc:" (:name params))
(str/ffmt ":%" (batch-key (:props params)))) label (cond
dedupe? (boolean (ifn? batch-key) (dm/str label ":" (batch-key (::rpc/params event)))
(and batch-key batch-timeout))] (string? batch-key) (dm/str label ":" batch-key)
:else label)
dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! ::wrk/conn pool (wrk/submit! ::wrk/conn pool
::wrk/task :process-webhook-event ::wrk/task :process-webhook-event
::wrk/queue :webhooks ::wrk/queue :webhooks
::wrk/max-retries 0 ::wrk/max-retries 0
::wrk/delay (or batch-timeout 0) ::wrk/delay (or batch-timeout 0)
::wrk/dedupe dedupe? ::wrk/dedupe dedupe?
::wrk/label ::wrk/label label
(str/ffmt "rpc:%1%2" (:name params) label-suffix)
::webhooks/event ::webhooks/event
(-> params (-> params

74
backend/src/app/loggers/database.clj
View file

@ -11,12 +11,12 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.util.async :as aa] [app.loggers.zmq :as lzmq]
[app.worker :as wrk]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig])) [integrant.core :as ig]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Error Listener ;; Error Listener
@ -27,7 +27,7 @@
(defonce enabled (atom true)) (defonce enabled (atom true))
(defn- persist-on-database! (defn- persist-on-database!
[{:keys [pool] :as cfg} {:keys [id] :as event}] [{:keys [::db/pool] :as cfg} {:keys [id] :as event}]
(when-not (db/read-only? pool) (when-not (db/read-only? pool)
(db/insert! pool :server-error-report {:id id :content (db/tjson event)}))) (db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
@ -53,41 +53,49 @@
(assoc :version (:full cf/version)) (assoc :version (:full cf/version))
(update :id #(or % (uuid/next))))) (update :id #(or % (uuid/next)))))
(defn handle-event (defn- handle-event
[{:keys [executor] :as cfg} event] [cfg event]
(aa/with-thread executor (try
(try (let [event (parse-event event)
(let [event (parse-event event) uri (cf/get :public-uri)]
uri (cf/get :public-uri)]
(l/debug :hint "registering error on database" :id (:id event) (l/debug :hint "registering error on database" :id (:id event)
:uri (str uri "/dbg/error/" (:id event))) :uri (str uri "/dbg/error/" (:id event)))
(persist-on-database! cfg event)) (persist-on-database! cfg event))
(catch Exception cause (catch Throwable cause
(l/warn :hint "unexpected exception on database error logger" :cause cause))))) (l/warn :hint "unexpected exception on database error logger" :cause cause))))
(defmethod ig/pre-init-spec ::reporter [_] (defn- error-event?
(s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
(defn error-event?
[event] [event]
(= "error" (:logger/level event))) (= "error" (:logger/level event)))
(defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req [::db/pool ::lzmq/receiver]))
(defmethod ig/init-key ::reporter (defmethod ig/init-key ::reporter
[_ {:keys [receiver] :as cfg}] [_ {:keys [::lzmq/receiver] :as cfg}]
(l/info :msg "initializing database error persistence") (px/thread
(let [output (a/chan (a/sliding-buffer 5) (filter error-event?))] {:name "penpot/database-reporter"}
(receiver :sub output) (l/info :hint "initializing database error persistence")
(a/go-loop []
(let [msg (a/<! output)] (let [input (a/chan (a/sliding-buffer 5)
(if (nil? msg) (filter error-event?))]
(l/info :msg "stopping error reporting loop") (try
(do (lzmq/sub! receiver input)
(a/<! (handle-event cfg msg)) (loop []
(recur))))) (when-let [msg (a/<!! input)]
output)) (handle-event cfg msg))
(recur))
(catch InterruptedException _
(l/debug :hint "reporter interrupted"))
(catch Throwable cause
(l/error :hint "unexpected error" :cause cause))
(finally
(a/close! input)
(l/info :hint "reporter terminated"))))))
(defmethod ig/halt-key! ::reporter (defmethod ig/halt-key! ::reporter
[_ output] [_ thread]
(a/close! output)) (some-> thread px/interrupt!))

14
backend/src/app/loggers/mattermost.clj
View file

@ -38,13 +38,13 @@
(defn handle-event (defn handle-event
[cfg event] [cfg event]
(try (when @enabled
(let [event (ldb/parse-event event)] (try
(when @enabled (let [event (ldb/parse-event event)]
(send-mattermost-notification! cfg event))) (send-mattermost-notification! cfg event))
(catch Throwable cause (catch Throwable cause
(l/warn :hint "unhandled error" (l/warn :hint "unhandled error"
:cause cause)))) :cause cause)))))
(defmethod ig/pre-init-spec ::reporter [_] (defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req [::http/client (s/keys :req [::http/client

10
backend/src/app/loggers/webhooks.clj
View file

@ -8,6 +8,7 @@
"A mattermost integration for error reporting." "A mattermost integration for error reporting."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.transit :as t] [app.common.transit :as t]
[app.common.uri :as uri] [app.common.uri :as uri]
@ -21,6 +22,15 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig])) [integrant.core :as ig]))
;; --- HELPERS
(defn key-fn
[k & keys]
(fn [params]
(reduce #(dm/str %1 ":" (get params %2))
(dm/str (get params k))
keys)))
;; --- PROC ;; --- PROC
(defn- lookup-webhooks-by-team (defn- lookup-webhooks-by-team

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

@ -6,6 +6,7 @@
(ns app.main (ns app.main
(:require (:require
[app.auth.ldap :as-alias ldap]
[app.auth.oidc :as-alias oidc] [app.auth.oidc :as-alias oidc]
[app.auth.oidc.providers :as-alias oidc.providers] [app.auth.oidc.providers :as-alias oidc.providers]
[app.common.logging :as l] [app.common.logging :as l]
@ -231,7 +232,7 @@
:max-body-size (cf/get :http-server-max-body-size) :max-body-size (cf/get :http-server-max-body-size)
:max-multipart-body-size (cf/get :http-server-max-multipart-body-size)} :max-multipart-body-size (cf/get :http-server-max-multipart-body-size)}
:app.auth.ldap/provider ::ldap/provider
{:host (cf/get :ldap-host) {:host (cf/get :ldap-host)
:port (cf/get :ldap-port) :port (cf/get :ldap-port)
:ssl (cf/get :ldap-ssl) :ssl (cf/get :ldap-ssl)
@ -327,6 +328,7 @@
::db/pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props) ::props (ig/ref :app.setup/props)
::ldap/provider (ig/ref ::ldap/provider)
:pool (ig/ref ::db/pool) :pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager) :session (ig/ref :app.http.session/manager)
:sprops (ig/ref :app.setup/props) :sprops (ig/ref :app.setup/props)
@ -335,7 +337,6 @@
:msgbus (ig/ref :app.msgbus/msgbus) :msgbus (ig/ref :app.msgbus/msgbus)
:public-uri (cf/get :public-uri) :public-uri (cf/get :public-uri)
:redis (ig/ref ::rds/redis) :redis (ig/ref ::rds/redis)
:ldap (ig/ref :app.auth.ldap/provider)
:http-client (ig/ref ::http.client/client) :http-client (ig/ref ::http.client/client)
:climit (ig/ref :app.rpc/climit) :climit (ig/ref :app.rpc/climit)
:rlimit (ig/ref :app.rpc/rlimit) :rlimit (ig/ref :app.rpc/rlimit)
@ -450,9 +451,8 @@
::http.client/client (ig/ref ::http.client/client)} ::http.client/client (ig/ref ::http.client/client)}
:app.loggers.database/reporter :app.loggers.database/reporter
{:receiver (ig/ref :app.loggers.zmq/receiver) {::lzmq/receiver (ig/ref :app.loggers.zmq/receiver)
:pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)}
:executor (ig/ref ::wrk/executor)}
::sto/storage ::sto/storage
{:pool (ig/ref ::db/pool) {:pool (ig/ref ::db/pool)

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

@ -6,6 +6,7 @@
(ns app.rpc (ns app.rpc
(:require (:require
[app.auth.ldap :as-alias ldap]
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
@ -72,12 +73,14 @@
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id params] :as request} respond raise] [methods {:keys [profile-id session-id params] :as request} respond raise]
(let [type (keyword (:type params)) (let [type (keyword (:type params))
data (into {::http/request request} params) data (-> params
(assoc ::request-at (dt/now))
(assoc ::http/request request))
data (if profile-id data (if profile-id
(assoc data (-> data
:profile-id profile-id (assoc :profile-id profile-id)
::profile-id profile-id (assoc ::profile-id profile-id)
::session-id session-id) (assoc ::session-id session-id))
(dissoc data :profile-id ::profile-id)) (dissoc data :profile-id ::profile-id))
method (get methods type default-handler)] method (get methods type default-handler)]
@ -93,14 +96,15 @@
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id params] :as request} respond raise] [methods {:keys [profile-id session-id params] :as request} respond raise]
(let [type (keyword (:type params)) (let [type (keyword (:type params))
data (into {::http/request request} params) data (-> params
(assoc ::request-at (dt/now))
(assoc ::http/request request))
data (if profile-id data (if profile-id
(assoc data (-> data
:profile-id profile-id (assoc :profile-id profile-id)
::profile-id profile-id (assoc ::profile-id profile-id)
::session-id session-id) (assoc ::session-id session-id))
(dissoc data :profile-id ::profile-id)) (dissoc data :profile-id ::profile-id))
method (get methods type default-handler)] method (get methods type default-handler)]
(-> (method data) (-> (method data)
(p/then (partial handle-response request)) (p/then (partial handle-response request))
@ -115,12 +119,15 @@
[methods {:keys [profile-id session-id params] :as request} respond raise] [methods {:keys [profile-id session-id params] :as request} respond raise]
(let [cmd (keyword (:type params)) (let [cmd (keyword (:type params))
etag (yrq/get-header request "if-none-match") etag (yrq/get-header request "if-none-match")
data (into {::request-at (dt/now)
::http/request request data (-> params
::cond/key etag} params) (assoc ::request-at (dt/now))
data (if profile-id (assoc ::http/request request)
(assoc data ::profile-id profile-id ::session-id session-id) (assoc ::cond/key etag)
(dissoc data ::profile-id)) (cond-> (uuid? profile-id)
(-> (assoc ::profile-id profile-id)
(assoc ::session-id session-id))))
method (get methods cmd default-handler)] method (get methods cmd default-handler)]
(binding [cond/*enabled* true] (binding [cond/*enabled* true]
(-> (method data) (-> (method data)
@ -184,6 +191,12 @@
:profile-id profile-id :profile-id profile-id
:ip-addr (some-> request audit/parse-client-ip) :ip-addr (some-> request audit/parse-client-ip)
:props props :props props
;; NOTE: for batch-key lookup we need the params as-is
;; because the rpc api does not need to know the
;; audit/webhook specific object layout.
::params (dissoc params ::http/request)
::webhooks/batch-key ::webhooks/batch-key
(or (::webhooks/batch-key mdata) (or (::webhooks/batch-key mdata)
(::webhooks/batch-key resultm)) (::webhooks/batch-key resultm))
@ -281,6 +294,7 @@
'app.rpc.commands.management 'app.rpc.commands.management
'app.rpc.commands.verify-token 'app.rpc.commands.verify-token
'app.rpc.commands.search 'app.rpc.commands.search
'app.rpc.commands.media
'app.rpc.commands.teams 'app.rpc.commands.teams
'app.rpc.commands.auth 'app.rpc.commands.auth
'app.rpc.commands.ldap 'app.rpc.commands.ldap
@ -306,6 +320,7 @@
(s/keys :req [::audit/collector (s/keys :req [::audit/collector
::http.client/client ::http.client/client
::db/pool ::db/pool
::ldap/provider
::wrk/executor] ::wrk/executor]
:req-un [::sto/storage :req-un [::sto/storage
::http.session/session ::http.session/session
@ -316,8 +331,7 @@
::climit ::climit
::wrk/executor ::wrk/executor
::mtx/metrics ::mtx/metrics
::db/pool ::db/pool]))
::ldap]))
(defmethod ig/init-key ::methods (defmethod ig/init-key ::methods
[_ cfg] [_ cfg]

2
backend/src/app/rpc/commands/audit.clj
View file

@ -72,7 +72,7 @@
(sv/defmethod ::push-audit-events (sv/defmethod ::push-audit-events
{::climit/queue :push-audit-events {::climit/queue :push-audit-events
::climit/key-fn :profile-id ::climit/key-fn ::rpc/profile-id
::audit/skip true ::audit/skip true
::doc/added "1.17"} ::doc/added "1.17"}
[{:keys [::db/pool ::wrk/executor] :as cfg} params] [{:keys [::db/pool ::wrk/executor] :as cfg} params]

4
backend/src/app/rpc/commands/comments.clj
View file

@ -288,7 +288,9 @@
(sv/defmethod ::create-comment-thread (sv/defmethod ::create-comment-thread
{::doc/added "1.15" {::doc/added "1.15"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}] [{:keys [::db/pool] :as cfg}
{:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)] (let [{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)

32
backend/src/app/rpc/commands/files.clj
View file

@ -268,7 +268,7 @@
{::doc/added "1.17" {::doc/added "1.17"
::cond/get-object #(get-minimal-file %1 (:id %2)) ::cond/get-object #(get-minimal-file %1 (:id %2))
::cond/key-fn get-file-etag} ::cond/key-fn get-file-etag}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id features] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id features]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id id)] (let [perms (get-permissions conn profile-id id)]
(check-read-permissions! perms) (check-read-permissions! perms)
@ -296,7 +296,7 @@
"Retrieve a file by its ID. Only authenticated users." "Retrieve a file by its ID. Only authenticated users."
{::doc/added "1.17" {::doc/added "1.17"
::rpc/:auth false} ::rpc/:auth false}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id file-id share-id)] (let [perms (get-permissions conn profile-id file-id share-id)]
(check-read-permissions! perms) (check-read-permissions! perms)
@ -363,7 +363,7 @@
(sv/defmethod ::get-project-files (sv/defmethod ::get-project-files
"Get all files for the specified project." "Get all files for the specified project."
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id) (projects/check-read-permissions! conn profile-id project-id)
(get-project-files conn project-id))) (get-project-files conn project-id)))
@ -376,15 +376,16 @@
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::has-file-libraries (s/def ::has-file-libraries
(s/keys :req [::rpc/profile-id] :req-un [::file-id])) (s/keys :req [::rpc/profile-id]
:req-un [::file-id]))
(sv/defmethod ::has-file-libraries (sv/defmethod ::has-file-libraries
"Checks if the file has libraries. Returns a boolean" "Checks if the file has libraries. Returns a boolean"
{::doc/added "1.15.1"} {::doc/added "1.15.1"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(check-read-permissions! pool profile-id file-id) (check-read-permissions! pool profile-id file-id)
(get-has-file-libraries conn params))) (get-has-file-libraries conn file-id)))
(def ^:private sql:has-file-libraries (def ^:private sql:has-file-libraries
"SELECT COUNT(*) > 0 AS has_libraries "SELECT COUNT(*) > 0 AS has_libraries
@ -395,7 +396,7 @@
fl.deleted_at > now())") fl.deleted_at > now())")
(defn- get-has-file-libraries (defn- get-has-file-libraries
[conn {:keys [file-id]}] [conn file-id]
(let [row (db/exec-one! conn [sql:has-file-libraries file-id])] (let [row (db/exec-one! conn [sql:has-file-libraries file-id])]
(:has-libraries row))) (:has-libraries row)))
@ -474,7 +475,7 @@
order by f.modified_at desc") order by f.modified_at desc")
(defn get-team-shared-files (defn get-team-shared-files
[conn {:keys [team-id] :as params}] [conn team-id]
(letfn [(assets-sample [assets limit] (letfn [(assets-sample [assets limit]
(let [sorted-assets (->> (vals assets) (let [sorted-assets (->> (vals assets)
(sort-by #(str/lower (:name %))))] (sort-by #(str/lower (:name %))))]
@ -494,14 +495,16 @@
(map #(dissoc % :data))))))) (map #(dissoc % :data)))))))
(s/def ::get-team-shared-files (s/def ::get-team-shared-files
(s/keys :req [::rpc/profile-id] :req-un [::team-id])) (s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(sv/defmethod ::get-team-shared-files (sv/defmethod ::get-team-shared-files
"Get all file (libraries) for the specified team." "Get all file (libraries) for the specified team."
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(get-team-shared-files conn params))) (teams/check-read-permissions! conn profile-id team-id)
(get-team-shared-files conn team-id)))
;; --- COMMAND QUERY: get-file-libraries ;; --- COMMAND QUERY: get-file-libraries
@ -552,7 +555,7 @@
(sv/defmethod ::get-file-libraries (sv/defmethod ::get-file-libraries
"Get libraries used by the specified file." "Get libraries used by the specified file."
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features]}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id) (check-read-permissions! conn profile-id file-id)
(get-file-libraries conn file-id features))) (get-file-libraries conn file-id features)))
@ -583,7 +586,6 @@
(check-read-permissions! conn profile-id file-id) (check-read-permissions! conn profile-id file-id)
(get-library-file-references conn file-id))) (get-library-file-references conn file-id)))
;; --- COMMAND QUERY: get-team-recent-files ;; --- COMMAND QUERY: get-team-recent-files
(def sql:team-recent-files (def sql:team-recent-files
@ -765,7 +767,7 @@
;; --- MUTATION COMMAND: rename-file ;; --- MUTATION COMMAND: rename-file
(defn rename-file (defn rename-file
[conn {:keys [id name] :as params}] [conn {:keys [id name]}]
(db/update! conn :file (db/update! conn :file
{:name name {:name name
:modified-at (dt/now)} :modified-at (dt/now)}
@ -899,7 +901,7 @@
;; --- MUTATION COMMAND: unlink-file-from-library ;; --- MUTATION COMMAND: unlink-file-from-library
(defn unlink-file-from-library (defn unlink-file-from-library
[conn {:keys [file-id library-id] :as params}] [conn {:keys [file-id library-id]}]
(db/delete! conn :file-library-rel (db/delete! conn :file-library-rel
{:file-id file-id {:file-id file-id
:library-file-id library-id})) :library-file-id library-id}))

4
backend/src/app/rpc/commands/files/update.clj
View file

@ -17,7 +17,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as webhooks]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.msgbus :as mbus] [app.msgbus :as mbus]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
@ -130,7 +130,7 @@
::climit/key-fn :id ::climit/key-fn :id
::webhooks/event? true ::webhooks/event? true
::webhooks/batch-timeout (dt/duration "2m") ::webhooks/batch-timeout (dt/duration "2m")
::webhooks/batch-key :id ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
::doc/added "1.17"} ::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]

16
backend/src/app/rpc/commands/ldap.clj
View file

@ -12,10 +12,13 @@
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.main :as-alias main]
[app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph] [app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.tokens :as tokens]
[app.util.services :as sv] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -34,15 +37,15 @@
(sv/defmethod ::login-with-ldap (sv/defmethod ::login-with-ldap
"Performs the authentication using LDAP backend. Only works if LDAP "Performs the authentication using LDAP backend. Only works if LDAP
is properly configured and enabled with `login-with-ldap` flag." is properly configured and enabled with `login-with-ldap` flag."
{:auth false {::rpc/auth false
::doc/added "1.15"} ::doc/added "1.15"}
[{:keys [session tokens ldap] :as cfg} params] [{:keys [::main/props ::ldap/provider session] :as cfg} params]
(when-not ldap (when-not provider
(ex/raise :type :restriction (ex/raise :type :restriction
:code :ldap-not-initialized :code :ldap-not-initialized
:hide "ldap auth provider is not initialized")) :hide "ldap auth provider is not initialized"))
(let [info (ldap/authenticate ldap params)] (let [info (ldap/authenticate provider params)]
(when-not info (when-not info
(ex/raise :type :validation (ex/raise :type :validation
:code :wrong-credentials)) :code :wrong-credentials))
@ -58,12 +61,11 @@
;; user comes from team-invitation process; in this case, ;; user comes from team-invitation process; in this case,
;; regenerate token and send back to the user a new invitation ;; regenerate token and send back to the user a new invitation
;; token (and mark current session as logged). ;; token (and mark current session as logged).
(let [claims (tokens :verify {:token token :iss :team-invitation}) (let [claims (tokens/verify props {:token token :iss :team-invitation})
claims (assoc claims claims (assoc claims
:member-id (:id profile) :member-id (:id profile)
:member-email (:email profile)) :member-email (:email profile))
token (tokens :generate claims)] token (tokens/generate props claims)]
(-> {:invitation-token token} (-> {:invitation-token token}
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn session (:id profile)))
(rph/with-meta {::audit/props (:props profile) (rph/with-meta {::audit/props (:props profile)

19
backend/src/app/rpc/commands/management.clj
View file

@ -46,9 +46,9 @@
"Duplicate a single file in the same team." "Duplicate a single file in the same team."
{::doc/added "1.16" {::doc/added "1.16"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(duplicate-file conn (assoc params :profile-id (::rpc/profile-id params))))) (duplicate-file conn (assoc params :profile-id profile-id))))
(defn- remap-id (defn- remap-id
[item index key] [item index key]
@ -136,7 +136,7 @@
and so.deleted_at is null") and so.deleted_at is null")
(defn duplicate-file* (defn duplicate-file*
[conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}] [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
(let [flibs (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)])) (let [flibs (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
fmeds (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)])) fmeds (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
@ -329,10 +329,9 @@
"Move a set of files from one project to other." "Move a set of files from one project to other."
{::doc/added "1.16" {::doc/added "1.16"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(move-files conn (assoc params :profile-id (::rpc/profile-id params))))) (move-files conn (assoc params :profile-id profile-id))))
;; --- COMMAND: Move project ;; --- COMMAND: Move project
@ -370,9 +369,9 @@
"Move projects between teams." "Move projects between teams."
{::doc/added "1.16" {::doc/added "1.16"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(move-project conn (assoc params :profile-id (::rpc/profile-id params))))) (move-project conn (assoc params :profile-id profile-id))))
;; --- COMMAND: Clone Template ;; --- COMMAND: Clone Template
@ -387,10 +386,10 @@
"Clone into the specified project the template by its id." "Clone into the specified project the template by its id."
{::doc/added "1.16" {::doc/added "1.16"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(-> (assoc cfg :conn conn) (-> (assoc cfg :conn conn)
(clone-template (assoc params :profile-id (::rpc/profile-id params)))))) (clone-template (assoc params :profile-id profile-id)))))
(defn- clone-template (defn- clone-template
[{:keys [conn templates] :as cfg} {:keys [profile-id template-id project-id]}] [{:keys [conn templates] :as cfg} {:keys [profile-id template-id project-id]}]

274
backend/src/app/rpc/commands/media.clj Normal file
View file

@ -0,0 +1,274 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.rpc.commands.media
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.http.client :as http]
[app.media :as media]
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit]
[app.rpc.commands.files :as files]
[app.rpc.doc :as-alias doc]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.core :as p]
[promesa.exec :as px]))
(def default-max-file-size
(* 1024 1024 10)) ; 10 MiB
(def thumbnail-options
{:width 100
:height 100
:quality 85
:format :jpeg})
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(defn validate-content-size!
[content]
(when (> (:size content) (cf/get :media-max-file-size default-max-file-size))
(ex/raise :type :restriction
:code :media-max-file-size-reached
:hint (str/ffmt "the uploaded file size % is greater than the maximum %"
(:size content)
default-max-file-size))))
;; --- Create File Media object (upload)
(declare create-file-media-object)
(s/def ::content ::media/upload)
(s/def ::is-local ::us/boolean)
(s/def ::upload-file-media-object
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::name ::content]
:opt-un [::id]))
(sv/defmethod ::upload-file-media-object
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id)
(media/validate-media-type! content)
(validate-content-size! content)
(create-file-media-object cfg params)))
(defn- big-enough-for-thumbnail?
"Checks if the provided image info is big enough for
create a separate thumbnail storage object."
[info]
(or (> (:width info) (:width thumbnail-options))
(> (:height info) (:height thumbnail-options))))
(defn- svg-image?
[info]
(= (:mtype info) "image/svg+xml"))
;; NOTE: we use the `on conflict do update` instead of `do nothing`
;; because postgresql does not returns anything if no update is
;; performed, the `do update` does the trick.
(def sql:create-file-media-object
"insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
values (?, ?, ?, ?, ?, ?, ?, ?, ?)
on conflict (id) do update set created_at=file_media_object.created_at
returning *")
;; NOTE: the following function executes without a transaction, this
;; means that if something fails in the middle of this function, it
;; will probably leave leaked/unreferenced objects in the database and
;; probably in the storage layer. For handle possible object leakage,
;; we create all media objects marked as touched, this ensures that if
;; something fails, all leaked (already created storage objects) will
;; be eventually marked as deleted by the touched-gc task.
;;
;; The touched-gc task, performs periodic analysis of all touched
;; storage objects and check references of it. This is the reason why
;; `reference` metadata exists: it indicates the name of the table
;; witch holds the reference to storage object (it some kind of
;; inverse, soft referential integrity).
(defn create-file-media-object
[{:keys [storage pool climit executor]}
{:keys [id file-id is-local name content]}]
(letfn [;; Function responsible to retrieve the file information, as
;; it is synchronous operation it should be wrapped into
;; with-dispatch macro.
(get-info [content]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :info :input content})))
;; Function responsible of calculating cryptographyc hash of
;; the provided data.
(calculate-hash [data]
(px/with-dispatch executor
(sto/calculate-hash data)))
;; Function responsible of generating thumnail. As it is synchronous
;; opetation, it should be wrapped into with-dispatch macro
(generate-thumbnail [info]
(climit/with-dispatch (:process-image climit)
(media/run (assoc thumbnail-options
:cmd :generic-thumbnail
:input info))))
(create-thumbnail [info]
(when (and (not (svg-image? info))
(big-enough-for-thumbnail? info))
(p/let [thumb (generate-thumbnail info)
hash (calculate-hash (:data thumb))
content (-> (sto/content (:data thumb) (:size thumb))
(sto/wrap-with-hash hash))]
(sto/put-object! storage
{::sto/content content
::sto/deduplicate? true
::sto/touched-at (dt/now)
:content-type (:mtype thumb)
:bucket "file-media-object"}))))
(create-image [info]
(p/let [data (:path info)
hash (calculate-hash data)
content (-> (sto/content data)
(sto/wrap-with-hash hash))]
(sto/put-object! storage
{::sto/content content
::sto/deduplicate? true
::sto/touched-at (dt/now)
:content-type (:mtype info)
:bucket "file-media-object"})))
(insert-into-database [info image thumb]
(px/with-dispatch executor
(db/exec-one! pool [sql:create-file-media-object
(or id (uuid/next))
file-id is-local name
(:id image)
(:id thumb)
(:width info)
(:height info)
(:mtype info)])))]
(p/let [info (get-info content)
thumb (create-thumbnail info)
image (create-image info)]
(insert-into-database info image thumb))))
;; --- Create File Media Object (from URL)
(declare ^:private create-file-media-object-from-url)
(s/def ::create-file-media-object-from-url
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::url]
:opt-un [::id ::name]))
(sv/defmethod ::create-file-media-object-from-url
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id)
(create-file-media-object-from-url cfg params)))
(defn- create-file-media-object-from-url
[cfg {:keys [url name] :as params}]
(letfn [(parse-and-validate-size [headers]
(let [size (some-> (get headers "content-length") d/parse-integer)
mtype (get headers "content-type")
format (cm/mtype->format mtype)
max-size (cf/get :media-max-file-size default-max-file-size)]
(when-not size
(ex/raise :type :validation
:code :unknown-size
:hint "seems like the url points to resource with unknown size"))
(when (> size max-size)
(ex/raise :type :validation
:code :file-too-large
:hint (str/ffmt "the file size % is greater than the maximum %"
size
default-max-file-size)))
(when (nil? format)
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "seems like the url points to an invalid media object"))
{:size size
:mtype mtype
:format format}))
(download-media [uri]
(-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
(p/then process-response)))
(process-response [{:keys [body headers] :as response}]
(let [{:keys [size mtype]} (parse-and-validate-size headers)
path (tmp/tempfile :prefix "penpot.media.download.")
written (io/write-to-file! body path :size size)]
(when (not= written size)
(ex/raise :type :internal
:code :mismatch-write-size
:hint "unexpected state: unable to write to file"))
{:filename "tempfile"
:size size
:path path
:mtype mtype}))]
(p/let [content (download-media url)]
(->> (merge params {:content content :name (or name (:filename content))})
(create-file-media-object cfg)))))
;; --- Clone File Media object (Upload and create from url)
(declare clone-file-media-object)
(s/def ::clone-file-media-object
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::id]))
(sv/defmethod ::clone-file-media-object
{::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(-> (assoc cfg :conn conn)
(clone-file-media-object params))))
(defn clone-file-media-object
[{:keys [conn]} {:keys [id file-id is-local]}]
(let [mobj (db/get-by-id conn :file-media-object id)]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
:is-local is-local
:name (:name mobj)
:media-id (:media-id mobj)
:thumbnail-id (:thumbnail-id mobj)
:width (:width mobj)
:height (:height mobj)
:mtype (:mtype mobj)})))

4
backend/src/app/rpc/commands/profile.clj
View file

@ -34,10 +34,10 @@
{::climit/queue :auth {::climit/queue :auth
::climit/key-fn ::rpc/profile-id ::climit/key-fn ::rpc/profile-id
::doc/added "1.18"} ::doc/added "1.18"}
[{:keys [::db/pool]} {:keys [password] :as params}] [{:keys [::db/pool]} {:keys [::rpc/profile-id password]}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [admins (cf/get :admins) (let [admins (cf/get :admins)
profile (db/get-by-id conn :profile (::rpc/profile-id params))] profile (db/get-by-id conn :profile profile-id)]
(if (or (:is-admin profile) (if (or (:is-admin profile)
(contains? admins (:email profile))) (contains? admins (:email profile)))

7
backend/src/app/rpc/commands/search.clj
View file

@ -48,7 +48,7 @@
order by f.created_at asc") order by f.created_at asc")
(defn search-files (defn search-files
[conn {:keys [::rpc/profile-id team-id search-term] :as params}] [conn profile-id team-id search-term]
(db/exec! conn [sql:search-files (db/exec! conn [sql:search-files
profile-id team-id profile-id team-id
profile-id team-id profile-id team-id
@ -64,6 +64,5 @@
(sv/defmethod ::search-files (sv/defmethod ::search-files
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool]} {:keys [search-term] :as params}] [{:keys [pool]} {:keys [::rpc/profile-id team-id search-term]}]
(when search-term (some->> search-term (search-files pool profile-id team-id)))
(search-files pool params)))

21
backend/src/app/rpc/commands/teams.clj
View file

@ -385,14 +385,8 @@
(declare role->params) (declare role->params)
(s/def ::reassign-to ::us/uuid)
(s/def ::leave-team
(s/keys :req [::rpc/profile-id]
:req-un [::id]
:opt-un [::reassign-to]))
(defn leave-team (defn leave-team
[conn {:keys [::rpc/profile-id id reassign-to]}] [conn {:keys [profile-id id reassign-to]}]
(let [perms (get-permissions conn profile-id id) (let [perms (get-permissions conn profile-id id)
members (retrieve-team-members conn id)] members (retrieve-team-members conn id)]
@ -437,12 +431,17 @@
nil)) nil))
(s/def ::reassign-to ::us/uuid)
(s/def ::leave-team
(s/keys :req [::rpc/profile-id]
:req-un [::id]
:opt-un [::reassign-to]))
(sv/defmethod ::leave-team (sv/defmethod ::leave-team
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(leave-team conn params))) (leave-team conn (assoc params :profile-id profile-id))))
;; --- Mutation: Delete Team ;; --- Mutation: Delete Team
@ -539,9 +538,9 @@
(sv/defmethod ::update-team-member-role (sv/defmethod ::update-team-member-role
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} params] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(update-team-member-role conn (assoc params :profile-id (::rpc/profile-id params))))) (update-team-member-role conn (assoc params :profile-id profile-id))))
;; --- Mutation: Delete Team Member ;; --- Mutation: Delete Team Member

4
backend/src/app/rpc/commands/viewer.clj
View file

@ -84,6 +84,6 @@
::cond/key-fn files/get-file-etag ::cond/key-fn files/get-file-etag
::cond/reuse-key? true ::cond/reuse-key? true
::doc/added "1.17"} ::doc/added "1.17"}
[{:keys [pool]} params] [{:keys [pool]} {:keys [::rpc/profile-id] :as params}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(get-view-only-bundle conn (assoc params :profile-id (::rpc/profile-id params))))) (get-view-only-bundle conn (assoc params :profile-id profile-id))))

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

@ -6,280 +6,49 @@
(ns app.rpc.mutations.media (ns app.rpc.mutations.media
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http.client :as http]
[app.media :as media] [app.media :as media]
[app.rpc.climit :as climit] [app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams] [app.rpc.commands.media :as cmd.media]
[app.storage :as sto] [app.rpc.doc :as-alias doc]
[app.storage.tmp :as tmp]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [clojure.spec.alpha :as s]))
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.core :as p]
[promesa.exec :as px]))
(def default-max-file-size (* 1024 1024 10)) ; 10 MiB
(def thumbnail-options
{:width 100
:height 100
:quality 85
:format :jpeg})
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
;; --- Create File Media object (upload) ;; --- Create File Media object (upload)
(declare create-file-media-object) (s/def ::upload-file-media-object ::cmd.media/upload-file-media-object)
(declare select-file)
(s/def ::content ::media/upload)
(s/def ::is-local ::us/boolean)
(s/def ::upload-file-media-object
(s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
:opt-un [::id]))
(sv/defmethod ::upload-file-media-object (sv/defmethod ::upload-file-media-object
{::doc/added "1.2"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
(let [file (select-file pool file-id) (let [cfg (update cfg :storage media/configure-assets-storage)]
cfg (update cfg :storage media/configure-assets-storage)] (files/check-edition-permissions! pool profile-id file-id)
(teams/check-edition-permissions! pool profile-id (:team-id file))
(media/validate-media-type! content) (media/validate-media-type! content)
(cmd.media/validate-content-size! content)
(when (> (:size content) (cf/get :media-max-file-size default-max-file-size)) (cmd.media/create-file-media-object cfg params)))
(ex/raise :type :restriction
:code :media-max-file-size-reached
:hint (str/ffmt "the uploaded file size % is greater than the maximum %"
(:size content)
default-max-file-size)))
(create-file-media-object cfg params)))
(defn- big-enough-for-thumbnail?
"Checks if the provided image info is big enough for
create a separate thumbnail storage object."
[info]
(or (> (:width info) (:width thumbnail-options))
(> (:height info) (:height thumbnail-options))))
(defn- svg-image?
[info]
(= (:mtype info) "image/svg+xml"))
;; NOTE: we use the `on conflict do update` instead of `do nothing`
;; because postgresql does not returns anything if no update is
;; performed, the `do update` does the trick.
(def sql:create-file-media-object
"insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
values (?, ?, ?, ?, ?, ?, ?, ?, ?)
on conflict (id) do update set created_at=file_media_object.created_at
returning *")
;; NOTE: the following function executes without a transaction, this
;; means that if something fails in the middle of this function, it
;; will probably leave leaked/unreferenced objects in the database and
;; probably in the storage layer. For handle possible object leakage,
;; we create all media objects marked as touched, this ensures that if
;; something fails, all leaked (already created storage objects) will
;; be eventually marked as deleted by the touched-gc task.
;;
;; The touched-gc task, performs periodic analysis of all touched
;; storage objects and check references of it. This is the reason why
;; `reference` metadata exists: it indicates the name of the table
;; witch holds the reference to storage object (it some kind of
;; inverse, soft referential integrity).
(defn create-file-media-object
[{:keys [storage pool climit executor] :as cfg}
{:keys [id file-id is-local name content] :as params}]
(letfn [;; Function responsible to retrieve the file information, as
;; it is synchronous operation it should be wrapped into
;; with-dispatch macro.
(get-info [content]
(climit/with-dispatch (:process-image climit)
(media/run {:cmd :info :input content})))
;; Function responsible of calculating cryptographyc hash of
;; the provided data.
(calculate-hash [data]
(px/with-dispatch executor
(sto/calculate-hash data)))
;; Function responsible of generating thumnail. As it is synchronous
;; opetation, it should be wrapped into with-dispatch macro
(generate-thumbnail [info]
(climit/with-dispatch (:process-image climit)
(media/run (assoc thumbnail-options
:cmd :generic-thumbnail
:input info))))
(create-thumbnail [info]
(when (and (not (svg-image? info))
(big-enough-for-thumbnail? info))
(p/let [thumb (generate-thumbnail info)
hash (calculate-hash (:data thumb))
content (-> (sto/content (:data thumb) (:size thumb))
(sto/wrap-with-hash hash))]
(sto/put-object! storage
{::sto/content content
::sto/deduplicate? true
::sto/touched-at (dt/now)
:content-type (:mtype thumb)
:bucket "file-media-object"}))))
(create-image [info]
(p/let [data (:path info)
hash (calculate-hash data)
content (-> (sto/content data)
(sto/wrap-with-hash hash))]
(sto/put-object! storage
{::sto/content content
::sto/deduplicate? true
::sto/touched-at (dt/now)
:content-type (:mtype info)
:bucket "file-media-object"})))
(insert-into-database [info image thumb]
(px/with-dispatch executor
(db/exec-one! pool [sql:create-file-media-object
(or id (uuid/next))
file-id is-local name
(:id image)
(:id thumb)
(:width info)
(:height info)
(:mtype info)])))]
(p/let [info (get-info content)
thumb (create-thumbnail info)
image (create-image info)]
(insert-into-database info image thumb))))
;; --- Create File Media Object (from URL) ;; --- Create File Media Object (from URL)
(declare ^:private create-file-media-object-from-url) (s/def ::create-file-media-object-from-url ::cmd.media/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 (sv/defmethod ::create-file-media-object-from-url
{::doc/added "1.3"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(let [file (select-file pool file-id) (let [cfg (update cfg :storage media/configure-assets-storage)]
cfg (update cfg :storage media/configure-assets-storage)] (files/check-edition-permissions! pool profile-id file-id)
(teams/check-edition-permissions! pool profile-id (:team-id file)) (#'cmd.media/create-file-media-object-from-url cfg params)))
(create-file-media-object-from-url cfg params)))
(defn- create-file-media-object-from-url
[cfg {:keys [url name] :as params}]
(letfn [(parse-and-validate-size [headers]
(let [size (some-> (get headers "content-length") d/parse-integer)
mtype (get headers "content-type")
format (cm/mtype->format mtype)
max-size (cf/get :media-max-file-size default-max-file-size)]
(when-not size
(ex/raise :type :validation
:code :unknown-size
:hint "seems like the url points to resource with unknown size"))
(when (> size max-size)
(ex/raise :type :validation
:code :file-too-large
:hint (str/ffmt "the file size % is greater than the maximum %"
size
default-max-file-size)))
(when (nil? format)
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "seems like the url points to an invalid media object"))
{:size size
:mtype mtype
:format format}))
(download-media [uri]
(-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
(p/then process-response)))
(process-response [{:keys [body headers] :as response}]
(let [{:keys [size mtype]} (parse-and-validate-size headers)
path (tmp/tempfile :prefix "penpot.media.download.")
written (io/write-to-file! body path :size size)]
(when (not= written size)
(ex/raise :type :internal
:code :mismatch-write-size
:hint "unexpected state: unable to write to file"))
{:filename "tempfile"
:size size
:path path
:mtype mtype}))]
(p/let [content (download-media url)]
(->> (merge params {:content content :name (or name (:filename content))})
(create-file-media-object cfg)))))
;; --- Clone File Media object (Upload and create from url) ;; --- Clone File Media object (Upload and create from url)
(declare clone-file-media-object) (s/def ::clone-file-media-object ::cmd.media/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 (sv/defmethod ::clone-file-media-object
{::doc/added "1.2"
::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [file (select-file conn file-id)] (files/check-edition-permissions! conn profile-id file-id)
(teams/check-edition-permissions! conn profile-id (:team-id file)) (-> (assoc cfg :conn conn)
(-> (assoc cfg :conn conn) (cmd.media/clone-file-media-object params))))
(clone-file-media-object params)))))
(defn clone-file-media-object
[{:keys [conn] :as cfg} {:keys [id file-id is-local]}]
(let [mobj (db/get-by-id conn :file-media-object id)]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
:is-local is-local
:name (:name mobj)
:media-id (:media-id mobj)
:thumbnail-id (:thumbnail-id mobj)
:width (:width mobj)
:height (:height mobj)
:mtype (:mtype mobj)})))
;; --- HELPERS
(def ^:private
sql:select-file
"select file.*,
project.team_id as team_id
from file
inner join project on (project.id = file.project_id)
where file.id = ?")
(defn- select-file
[conn id]
(let [row (db/exec-one! conn [sql:select-file id])]
(when-not row
(ex/raise :type :not-found))
row))

5
backend/src/app/rpc/queries/files.clj
View file

@ -179,6 +179,5 @@
(sv/defmethod ::search-files (sv/defmethod ::search-files
{::doc/added "1.0" {::doc/added "1.0"
::doc/deprecated "1.17"} ::doc/deprecated "1.17"}
[{:keys [pool]} {:keys [search-term] :as params}] [{:keys [pool]} {:keys [profile-id team-id search-term]}]
(when search-term (some->> search-term (search/search-files pool profile-id team-id)))
(search/search-files pool params)))

178
backend/test/backend_tests/rpc_file_test.clj
View file

@ -6,13 +6,14 @@
(ns backend-tests.rpc-file-test (ns backend-tests.rpc-file-test
(:require (:require
[backend-tests.helpers :as th]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
[app.http :as http] [app.http :as http]
[app.rpc :as-alias rpc]
[app.storage :as sto] [app.storage :as sto]
[app.util.time :as dt] [app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.test :as t] [clojure.test :as t]
[datoteka.core :as fs])) [datoteka.core :as fs]))
@ -28,13 +29,13 @@
(t/testing "create file" (t/testing "create file"
(let [data {::th/type :create-file (let [data {::th/type :create-file
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:project-id proj-id :project-id proj-id
:id file-id :id file-id
:name "foobar" :name "foobar"
:is-shared false :is-shared false
:components-v2 true} :components-v2 true}
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -47,8 +48,8 @@
(let [data {::th/type :rename-file (let [data {::th/type :rename-file
:id file-id :id file-id
:name "new name" :name "new name"
:profile-id (:id prof)} ::rpc/profile-id (:id prof)}
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [result (:result out)] (let [result (:result out)]
@ -56,10 +57,10 @@
(t/is (= (:name data) (:name result)))))) (t/is (= (:name data) (:name result))))))
(t/testing "query files" (t/testing "query files"
(let [data {::th/type :project-files (let [data {::th/type :get-project-files
:project-id proj-id ::rpc/profile-id (:id prof)
:profile-id (:id prof)} :project-id proj-id}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -70,11 +71,11 @@
(t/is (= "new name" (get-in result [0 :name])))))) (t/is (= "new name" (get-in result [0 :name]))))))
(t/testing "query single file without users" (t/testing "query single file without users"
(let [data {::th/type :file (let [data {::th/type :get-file
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:id file-id :id file-id
:components-v2 true} :components-v2 true}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -88,18 +89,18 @@
(t/testing "delete file" (t/testing "delete file"
(let [data {::th/type :delete-file (let [data {::th/type :delete-file
:id file-id :id file-id
:profile-id (:id prof)} ::rpc/profile-id (:id prof)}
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (nil? (:result out))))) (t/is (nil? (:result out)))))
(t/testing "query single file after delete" (t/testing "query single file after delete"
(let [data {::th/type :file (let [data {::th/type :get-file
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:id file-id :id file-id
:components-v2 true} :components-v2 true}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -109,10 +110,10 @@
(t/is (= (:type error-data) :not-found))))) (t/is (= (:type error-data) :not-found)))))
(t/testing "query list files after delete" (t/testing "query list files after delete"
(let [data {::th/type :project-files (let [data {::th/type :get-project-files
:project-id proj-id ::rpc/profile-id (:id prof)
:profile-id (:id prof)} :project-id proj-id}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -136,19 +137,18 @@
out (th/mutation! params)] out (th/mutation! params)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(:result out))) (:result out)))
(update-file [{:keys [profile-id file-id changes revn] :or {revn 0}}] (update-file [{:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file (let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id :id file-id
:session-id (uuid/random) :session-id (uuid/random)
:profile-id profile-id
:revn revn :revn revn
:components-v2 true :components-v2 true
:changes changes} :changes changes}
out (th/mutation! params)] out (th/command! params)]
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(:result out)))] (:result out)))]
@ -257,12 +257,12 @@
profile2 (th/create-profile* 2) profile2 (th/create-profile* 2)
data {::th/type :create-file data {::th/type :create-file
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:project-id (:default-project-id profile1) :project-id (:default-project-id profile1)
:name "foobar" :name "foobar"
:is-shared false :is-shared false
:components-v2 true} :components-v2 true}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -277,9 +277,9 @@
:profile-id (:id profile1)}) :profile-id (:id profile1)})
data {::th/type :rename-file data {::th/type :rename-file
:id (:id file) :id (:id file)
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:name "foobar"} :name "foobar"}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -293,9 +293,9 @@
file (th/create-file* 1 {:project-id (:default-project-id profile1) file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)}) :profile-id (:id profile1)})
data {::th/type :delete-file data {::th/type :delete-file
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:id (:id file)} :id (:id file)}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -308,10 +308,10 @@
file (th/create-file* 1 {:project-id (:default-project-id profile1) file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)}) :profile-id (:id profile1)})
data {::th/type :set-file-shared data {::th/type :set-file-shared
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:id (:id file) :id (:id file)
:is-shared true} :is-shared true}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -328,11 +328,11 @@
:profile-id (:id profile1)}) :profile-id (:id profile1)})
data {::th/type :link-file-to-library data {::th/type :link-file-to-library
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:file-id (:id file2) :file-id (:id file2)
:library-id (:id file1)} :library-id (:id file1)}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -350,11 +350,11 @@
:profile-id (:id profile2)}) :profile-id (:id profile2)})
data {::th/type :link-file-to-library data {::th/type :link-file-to-library
:profile-id (:id profile2) ::rpc/profile-id (:id profile2)
:file-id (:id file2) :file-id (:id file2)
:library-id (:id file1)} :library-id (:id file1)}
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -372,10 +372,10 @@
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of files ;; query the list of files
(let [data {::th/type :project-files (let [data {::th/type :get-project-files
:project-id (:default-project-id profile1) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)} :project-id (:default-project-id profile1)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
@ -384,15 +384,15 @@
;; Request file to be deleted ;; Request file to be deleted
(let [params {::th/type :delete-file (let [params {::th/type :delete-file
:id (:id file) :id (:id file)
:profile-id (:id profile1)} ::rpc/profile-id (:id profile1)}
out (th/mutation! params)] out (th/command! params)]
(t/is (nil? (:error out)))) (t/is (nil? (:error out))))
;; query the list of files after soft deletion ;; query the list of files after soft deletion
(let [data {::th/type :project-files (let [data {::th/type :get-project-files
:project-id (:default-project-id profile1) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)} :project-id (:default-project-id profile1)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
@ -403,10 +403,10 @@
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of file libraries of a after hard deletion ;; query the list of file libraries of a after hard deletion
(let [data {::th/type :file-libraries (let [data {::th/type :get-file-libraries
:file-id (:id file) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)} :file-id (:id file)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
@ -417,10 +417,10 @@
(t/is (= 1 (:processed result)))) (t/is (= 1 (:processed result))))
;; query the list of file libraries of a after hard deletion ;; query the list of file libraries of a after hard deletion
(let [data {::th/type :file-libraries (let [data {::th/type :get-file-libraries
:file-id (:id file) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)} :file-id (:id file)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [error (:error out) (let [error (:error out)
error-data (ex-data error)] error-data (ex-data error)]
@ -483,11 +483,11 @@
(t/testing "RPC page query (rendering purposes)" (t/testing "RPC page query (rendering purposes)"
;; Query :page RPC method without passing page-id ;; Query :page RPC method without passing page-id
(let [data {::th/type :page (let [data {::th/type :get-page
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:components-v2 true} :components-v2 true}
{:keys [error result] :as out} (th/query! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (map? result)) (t/is (map? result))
@ -500,12 +500,12 @@
) )
;; Query :page RPC method with page-id ;; Query :page RPC method with page-id
(let [data {::th/type :page (let [data {::th/type :get-page
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:page-id page-id :page-id page-id
:components-v2 true} :components-v2 true}
{:keys [error result] :as out} (th/query! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (map? result)) (t/is (map? result))
(t/is (contains? result :objects)) (t/is (contains? result :objects))
@ -516,13 +516,13 @@
(t/is (contains? (:objects result) uuid/zero))) (t/is (contains? (:objects result) uuid/zero)))
;; Query :page RPC method with page-id and object-id ;; Query :page RPC method with page-id and object-id
(let [data {::th/type :page (let [data {::th/type :get-page
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:page-id page-id :page-id page-id
:object-id frame1-id :object-id frame1-id
:components-v2 true} :components-v2 true}
{:keys [error result] :as out} (th/query! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (map? result)) (t/is (map? result))
@ -534,12 +534,12 @@
(t/is (not (contains? (:objects result) shape2-id)))) (t/is (not (contains? (:objects result) shape2-id))))
;; Query :page RPC method with wrong params ;; Query :page RPC method with wrong params
(let [data {::th/type :page (let [data {::th/type :get-page
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:object-id frame1-id :object-id frame1-id
:components-v2 true} :components-v2 true}
out (th/query! data)] out (th/command! data)]
(t/is (not (th/success? out))) (t/is (not (th/success? out)))
(let [{:keys [type code]} (-> out :error ex-data)] (let [{:keys [type code]} (-> out :error ex-data)]
@ -551,21 +551,21 @@
(t/testing "RPC :file-data-for-thumbnail" (t/testing "RPC :file-data-for-thumbnail"
;; Insert a thumbnail data for the frame-id ;; Insert a thumbnail data for the frame-id
(let [data {::th/type :upsert-file-object-thumbnail (let [data {::th/type :upsert-file-object-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:object-id (str page-id frame1-id) :object-id (str page-id frame1-id)
:data "random-data-1"} :data "random-data-1"}
{:keys [error result] :as out} (th/mutation! data)] {:keys [error result] :as out} (th/command! data)]
(t/is (nil? error)) (t/is (nil? error))
(t/is (nil? result))) (t/is (nil? result)))
;; Check the result ;; Check the result
(let [data {::th/type :file-data-for-thumbnail (let [data {::th/type :get-file-data-for-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:components-v2 true} :components-v2 true}
{:keys [error result] :as out} (th/query! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (map? result)) (t/is (map? result))
(t/is (contains? result :page)) (t/is (contains? result :page))
@ -578,21 +578,21 @@
;; Delete thumbnail data ;; Delete thumbnail data
(let [data {::th/type :upsert-file-object-thumbnail (let [data {::th/type :upsert-file-object-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:object-id (str page-id frame1-id) :object-id (str page-id frame1-id)
:data nil} :data nil}
{:keys [error result] :as out} (th/mutation! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (nil? result))) (t/is (nil? result)))
;; Check the result ;; Check the result
(let [data {::th/type :file-data-for-thumbnail (let [data {::th/type :get-file-data-for-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:components-v2 true} :components-v2 true}
{:keys [error result] :as out} (th/query! data)] {:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (map? result)) (t/is (map? result))
(t/is (contains? result :page)) (t/is (contains? result :page))
@ -606,11 +606,11 @@
;; insert object snapshot for known frame ;; insert object snapshot for known frame
(let [data {::th/type :upsert-file-object-thumbnail (let [data {::th/type :upsert-file-object-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:object-id (str page-id frame1-id) :object-id (str page-id frame1-id)
:data "new-data"} :data "new-data"}
{:keys [error result] :as out} (th/mutation! data)] {:keys [error result] :as out} (th/command! data)]
(t/is (nil? error)) (t/is (nil? error))
(t/is (nil? result))) (t/is (nil? result)))
@ -629,11 +629,11 @@
;; insert object snapshot for for unknown frame ;; insert object snapshot for for unknown frame
(let [data {::th/type :upsert-file-object-thumbnail (let [data {::th/type :upsert-file-object-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:object-id (str page-id (uuid/next)) :object-id (str page-id (uuid/next))
:data "new-data-2"} :data "new-data-2"}
{:keys [error result] :as out} (th/mutation! data)] {:keys [error result] :as out} (th/command! data)]
(t/is (nil? error)) (t/is (nil? error))
(t/is (nil? result))) (t/is (nil? result)))
@ -661,8 +661,8 @@
:project-id (:default-project-id prof) :project-id (:default-project-id prof)
:revn 2 :revn 2
:is-shared false}) :is-shared false})
data {::th/type :file-thumbnail data {::th/type :get-file-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file)}] :file-id (:id file)}]
(t/testing "query a thumbnail with single revn" (t/testing "query a thumbnail with single revn"
@ -673,7 +673,7 @@
:revn 1 :revn 1
:data "testvalue1"}) :data "testvalue1"})
(let [{:keys [result error] :as out} (th/query! data)] (let [{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (= 4 (count result))) (t/is (= 4 (count result)))
@ -687,7 +687,7 @@
:revn 2 :revn 2
:data "testvalue2"}) :data "testvalue2"})
(let [{:keys [result error] :as out} (th/query! data)] (let [{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (= 4 (count result))) (t/is (= 4 (count result)))
@ -695,7 +695,7 @@
(t/is (= 2 (:revn result)))) (t/is (= 2 (:revn result))))
;; Then query the specific revn ;; Then query the specific revn
(let [{:keys [result error] :as out} (th/query! (assoc data :revn 1))] (let [{:keys [result error] :as out} (th/command! (assoc data :revn 1))]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (= 4 (count result))) (t/is (= 4 (count result)))
@ -704,18 +704,18 @@
(t/testing "upsert file-thumbnail" (t/testing "upsert file-thumbnail"
(let [data {::th/type :upsert-file-thumbnail (let [data {::th/type :upsert-file-thumbnail
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:data "foobar" :data "foobar"
:props {:baz 1} :props {:baz 1}
:revn 2} :revn 2}
{:keys [result error] :as out} (th/mutation! data)] {:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (nil? result)))) (t/is (nil? result))))
(t/testing "query last result" (t/testing "query last result"
(let [{:keys [result error] :as out} (th/query! data)] (let [{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (= 4 (count result))) (t/is (= 4 (count result)))
@ -734,7 +734,7 @@
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; Then query the specific revn ;; Then query the specific revn
(let [{:keys [result error] :as out} (th/query! (assoc data :revn 1))] (let [{:keys [result error] :as out} (th/command! (assoc data :revn 1))]
(t/is (th/ex-of-type? error :not-found)) (t/is (th/ex-of-type? error :not-found))
(t/is (th/ex-of-code? error :file-thumbnail-not-found)))) (t/is (th/ex-of-code? error :file-thumbnail-not-found))))
)) ))

123
backend/test/backend_tests/rpc_media_test.clj
View file

@ -6,10 +6,11 @@
(ns backend-tests.rpc-media-test (ns backend-tests.rpc-media-test
(:require (:require
[backend-tests.helpers :as th]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.rpc :as-alias rpc]
[app.storage :as sto] [app.storage :as sto]
[backend-tests.helpers :as th]
[clojure.test :as t] [clojure.test :as t]
[datoteka.core :as fs])) [datoteka.core :as fs]))
@ -134,3 +135,123 @@
(t/is (= "image/jpeg" (:mtype result))) (t/is (= "image/jpeg" (:mtype result)))
(t/is (uuid? (:media-id result))) (t/is (uuid? (:media-id result)))
(t/is (uuid? (:thumbnail-id result)))))) (t/is (uuid? (:thumbnail-id result))))))
(t/deftest media-object-from-url-command
(let [prof (th/create-profile* 1)
proj (th/create-project* 1 {:profile-id (:id prof)
:team-id (:default-team-id prof)})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:is-shared false})
url "https://raw.githubusercontent.com/uxbox/uxbox/develop/sample_media/images/unsplash/anna-pelzer.jpg"
params {::th/type :create-file-media-object-from-url
::rpc/profile-id (:id prof)
:file-id (:id file)
:is-local true
:url url}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [{:keys [media-id thumbnail-id] :as result} (:result out)]
(t/is (= (:id file) (:file-id result)))
(t/is (= 1024 (:width result)))
(t/is (= 683 (:height result)))
(t/is (= "image/jpeg" (:mtype result)))
(t/is (uuid? media-id))
(t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)]
(t/is (sto/storage-object? mobj1))
(t/is (sto/storage-object? mobj2))
(t/is (= 122785 (:size mobj1)))
;; This is because in ubuntu 21.04 generates different
;; thumbnail that in ubuntu 22.04. This hack should be removed
;; when we all use the ubuntu 22.04 devenv image.
(t/is (or (= 3302 (:size mobj2))
(= 3303 (:size mobj2))))))))
(t/deftest media-object-upload-command
(let [prof (th/create-profile* 1)
proj (th/create-project* 1 {:profile-id (:id prof)
:team-id (:default-team-id prof)})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:is-shared false})
mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :upload-file-media-object
::rpc/profile-id (:id prof)
:file-id (:id file)
:is-local true
:name "testfile"
:content mfile}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [{:keys [media-id thumbnail-id] :as result} (:result out)]
(t/is (= (:id file) (:file-id result)))
(t/is (= 800 (:width result)))
(t/is (= 800 (:height result)))
(t/is (= "image/jpeg" (:mtype result)))
(t/is (uuid? media-id))
(t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)]
(t/is (sto/storage-object? mobj1))
(t/is (sto/storage-object? mobj2))
(t/is (= 312043 (:size mobj1)))
(t/is (= 3887 (:size mobj2)))))
))
(t/deftest media-object-upload-idempotency-command
(let [prof (th/create-profile* 1)
proj (th/create-project* 1 {:profile-id (:id prof)
:team-id (:default-team-id prof)})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:is-shared false})
mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :upload-file-media-object
::rpc/profile-id (:id prof)
:file-id (:id file)
:is-local true
:name "testfile"
:content mfile
:id (uuid/next)}]
;; First try
(let [{:keys [result error] :as out} (th/command! params)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (= (:id params) (:id result)))
(t/is (= (:file-id params) (:file-id result)))
(t/is (= 800 (:width result)))
(t/is (= 800 (:height result)))
(t/is (= "image/jpeg" (:mtype result)))
(t/is (uuid? (:media-id result)))
(t/is (uuid? (:thumbnail-id result))))
;; Second try
(let [{:keys [result error] :as out} (th/command! params)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (= (:id params) (:id result)))
(t/is (= (:file-id params) (:file-id result)))
(t/is (= 800 (:width result)))
(t/is (= 800 (:height result)))
(t/is (= "image/jpeg" (:mtype result)))
(t/is (uuid? (:media-id result)))
(t/is (uuid? (:thumbnail-id result))))))

96
backend/test/backend_tests/rpc_team_test.clj
View file

@ -21,7 +21,7 @@
(t/use-fixtures :once th/state-init) (t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest invite-team-member (t/deftest create-team-invitations
(with-mocks [mock {:target 'app.emails/send! :return nil}] (with-mocks [mock {:target 'app.emails/send! :return nil}]
(let [profile1 (th/create-profile* 1 {:is-active true}) (let [profile1 (th/create-profile* 1 {:is-active true})
profile2 (th/create-profile* 2 {:is-active true}) profile2 (th/create-profile* 2 {:is-active true})
@ -30,14 +30,14 @@
team (th/create-team* 1 {:profile-id (:id profile1)}) team (th/create-team* 1 {:profile-id (:id profile1)})
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
data {::th/type :invite-team-member data {::th/type :create-team-invitations
::rpc/profile-id (:id profile1)
:team-id (:id team) :team-id (:id team)
:role :editor :role :editor}]
:profile-id (:id profile1)}]
;; invite external user without complaints ;; invite external user without complaints
(let [data (assoc data :email "foo@bar.com") (let [data (assoc data :email "foo@bar.com")
out (th/mutation! data) out (th/command! data)
;; retrieve the value from the database and check its content ;; retrieve the value from the database and check its content
invitation (db/exec-one! invitation (db/exec-one!
th/*pool* th/*pool*
@ -52,7 +52,7 @@
;; invite internal user without complaints ;; invite internal user without complaints
(th/reset-mock! mock) (th/reset-mock! mock)
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/mutation! data)] out (th/command! data)]
(t/is (th/success? out)) (t/is (th/success? out))
(t/is (= 1 (:call-count (deref mock))))) (t/is (= 1 (:call-count (deref mock)))))
@ -60,7 +60,7 @@
(th/create-global-complaint-for pool {:type :complaint :email "foo@bar.com"}) (th/create-global-complaint-for pool {:type :complaint :email "foo@bar.com"})
(th/reset-mock! mock) (th/reset-mock! mock)
(let [data (assoc data :email "foo@bar.com") (let [data (assoc data :email "foo@bar.com")
out (th/mutation! data)] out (th/command! data)]
(t/is (th/success? out)) (t/is (th/success? out))
(t/is (= 1 (:call-count (deref mock))))) (t/is (= 1 (:call-count (deref mock)))))
@ -79,7 +79,7 @@
(th/create-global-complaint-for pool {:type :bounce :email "foo@bar.com"}) (th/create-global-complaint-for pool {:type :bounce :email "foo@bar.com"})
(let [data (assoc data :email "foo@bar.com") (let [data (assoc data :email "foo@bar.com")
out (th/mutation! data)] out (th/command! data)]
(t/is (not (th/success? out))) (t/is (not (th/success? out)))
(t/is (= 0 (:call-count @mock))) (t/is (= 0 (:call-count @mock)))
@ -92,7 +92,7 @@
(th/reset-mock! mock) (th/reset-mock! mock)
(let [data (assoc data :email (:email profile3)) (let [data (assoc data :email (:email profile3))
out (th/mutation! data)] out (th/command! data)]
(t/is (not (th/success? out))) (t/is (not (th/success? out)))
(t/is (= 0 (:call-count @mock))) (t/is (= 0 (:call-count @mock)))
@ -115,12 +115,12 @@
pool (:app.db/pool th/*system*)] pool (:app.db/pool th/*system*)]
;; Try to invite a not existing user ;; Try to invite a not existing user
(let [data {::th/type :invite-team-member (let [data {::th/type :create-team-invitations
::rpc/profile-id (:id profile1)
:email "notexisting@example.com" :email "notexisting@example.com"
:team-id (:id team) :team-id (:id team)
:role :editor :role :editor}
:profile-id (:id profile1)} out (th/command! data)]
out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/success? out)) (t/is (th/success? out))
@ -139,12 +139,12 @@
(th/reset-mock! mock) (th/reset-mock! mock)
;; Try to invite existing user ;; Try to invite existing user
(let [data {::th/type :invite-team-member (let [data {::th/type :create-team-invitations
::rpc/profile-id (:id profile1)
:email (:email profile2) :email (:email profile2)
:team-id (:id team) :team-id (:id team)
:role :editor :role :editor}
:profile-id (:id profile1)} out (th/command! data)]
out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/success? out)) (t/is (th/success? out))
@ -215,7 +215,9 @@
:role "editor" :role "editor"
:valid-until (dt/in-future "48h")}) :valid-until (dt/in-future "48h")})
(let [data {::th/type :verify-token :token token ::rpc/profile-id (:id profile2)} (let [data {::th/type :verify-token
::rpc/profile-id (:id profile2)
:token token}
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/success? out)) (t/is (th/success? out))
@ -236,7 +238,9 @@
:role "editor" :role "editor"
:valid-until (dt/in-future "48h")}) :valid-until (dt/in-future "48h")})
(let [data {::th/type :verify-token :token token ::rpc/profile-id (:id profile1)} (let [data {::th/type :verify-token
::rpc/profile-id (:id profile1)
:token token}
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (not (th/success? out))) (t/is (not (th/success? out)))
@ -246,7 +250,7 @@
))) )))
(t/deftest invite-team-member-with-email-verification-disabled (t/deftest create-team-invitations-with-email-verification-disabled
(with-mocks [mock {:target 'app.emails/send! :return nil}] (with-mocks [mock {:target 'app.emails/send! :return nil}]
(let [profile1 (th/create-profile* 1 {:is-active true}) (let [profile1 (th/create-profile* 1 {:is-active true})
profile2 (th/create-profile* 2 {:is-active true}) profile2 (th/create-profile* 2 {:is-active true})
@ -255,16 +259,16 @@
team (th/create-team* 1 {:profile-id (:id profile1)}) team (th/create-team* 1 {:profile-id (:id profile1)})
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
data {::th/type :invite-team-member data {::th/type :create-team-invitations
::rpc/profile-id (:id profile1)
:team-id (:id team) :team-id (:id team)
:role :editor :role :editor}]
:profile-id (:id profile1)}]
;; invite internal user without complaints ;; invite internal user without complaints
(with-redefs [app.config/flags #{}] (with-redefs [app.config/flags #{}]
(th/reset-mock! mock) (th/reset-mock! mock)
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/mutation! data)] out (th/command! data)]
(t/is (th/success? out)) (t/is (th/success? out))
(t/is (= 0 (:call-count (deref mock))))) (t/is (= 0 (:call-count (deref mock)))))
@ -279,8 +283,8 @@
team (th/create-team* 1 {:profile-id (:id profile1)}) team (th/create-team* 1 {:profile-id (:id profile1)})
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
data {::th/type :delete-team data {::th/type :delete-team
:team-id (:id team) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)}] :team-id (:id team)}]
;; team is not deleted because it does not meet all ;; team is not deleted because it does not meet all
;; conditions to be deleted. ;; conditions to be deleted.
@ -288,9 +292,9 @@
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of teams ;; query the list of teams
(let [data {::th/type :teams (let [data {::th/type :get-teams
:profile-id (:id profile1)} ::rpc/profile-id (:id profile1)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/success? out)) (t/is (th/success? out))
(let [result (:result out)] (let [result (:result out)]
@ -300,15 +304,15 @@
;; Request team to be deleted ;; Request team to be deleted
(let [params {::th/type :delete-team (let [params {::th/type :delete-team
:id (:id team) ::rpc/profile-id (:id profile1)
:profile-id (:id profile1)} :id (:id team)}
out (th/mutation! params)] out (th/command! params)]
(t/is (th/success? out))) (t/is (th/success? out)))
;; query the list of teams after soft deletion ;; query the list of teams after soft deletion
(let [data {::th/type :teams (let [data {::th/type :get-teams
:profile-id (:id profile1)} ::rpc/profile-id (:id profile1)}
out (th/query! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/success? out)) (t/is (th/success? out))
(let [result (:result out)] (let [result (:result out)]
@ -321,8 +325,8 @@
;; query the list of projects after hard deletion ;; query the list of projects after hard deletion
(let [data {::th/type :projects (let [data {::th/type :projects
:team-id (:id team) :profile-id (:id profile1)
:profile-id (:id profile1)} :team-id (:id team)}
out (th/query! data)] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (not (th/success? out))) (t/is (not (th/success? out)))
@ -335,8 +339,8 @@
;; query the list of projects of a after hard deletion ;; query the list of projects of a after hard deletion
(let [data {::th/type :projects (let [data {::th/type :projects
:team-id (:id team) :profile-id (:id profile1)
:profile-id (:id profile1)} :team-id (:id team)}
out (th/query! data)] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
@ -348,8 +352,8 @@
(t/deftest query-team-invitations (t/deftest query-team-invitations
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id prof)}) team (th/create-team* 1 {:profile-id (:id prof)})
data {::th/type :team-invitations data {::th/type :get-team-invitations
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:team-id (:id team)}] :team-id (:id team)}]
;; insert an entry on the database with an enabled invitation ;; insert an entry on the database with an enabled invitation
@ -366,7 +370,7 @@
:role "editor" :role "editor"
:valid-until (dt/in-past "48h")}) :valid-until (dt/in-past "48h")})
(let [out (th/query! data)] (let [out (th/command! data)]
(t/is (th/success? out)) (t/is (th/success? out))
(let [result (:result out) (let [result (:result out)
one (first result) one (first result)
@ -381,7 +385,7 @@
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id prof)}) team (th/create-team* 1 {:profile-id (:id prof)})
data {::th/type :update-team-invitation-role data {::th/type :update-team-invitation-role
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:team-id (:id team) :team-id (:id team)
:email "TEST1@mail.com" :email "TEST1@mail.com"
:role :admin}] :role :admin}]
@ -393,7 +397,7 @@
:role "editor" :role "editor"
:valid-until (dt/in-future "48h")}) :valid-until (dt/in-future "48h")})
(let [out (th/mutation! data) (let [out (th/command! data)
;; retrieve the value from the database and check its content ;; retrieve the value from the database and check its content
res (db/get* th/*pool* :team-invitation res (db/get* th/*pool* :team-invitation
{:team-id (:team-id data) :email-to "test1@mail.com"})] {:team-id (:team-id data) :email-to "test1@mail.com"})]
@ -405,7 +409,7 @@
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id prof)}) team (th/create-team* 1 {:profile-id (:id prof)})
data {::th/type :delete-team-invitation data {::th/type :delete-team-invitation
:profile-id (:id prof) ::rpc/profile-id (:id prof)
:team-id (:id team) :team-id (:id team)
:email "TEST1@mail.com"}] :email "TEST1@mail.com"}]
@ -416,7 +420,7 @@
:role "editor" :role "editor"
:valid-until (dt/in-future "48h")}) :valid-until (dt/in-future "48h")})
(let [out (th/mutation! data) (let [out (th/command! data)
;; retrieve the value from the database and check its content ;; retrieve the value from the database and check its content
res (db/get* th/*pool* :team-invitation res (db/get* th/*pool* :team-invitation
{:team-id (:team-id data) :email-to "test1@mail.com"})] {:team-id (:team-id data) :email-to "test1@mail.com"})]

2
common/deps.edn
View file

@ -23,7 +23,7 @@
com.cognitect/transit-cljs {:mvn/version "0.8.280"} com.cognitect/transit-cljs {:mvn/version "0.8.280"}
java-http-clj/java-http-clj {:mvn/version "0.4.3"} java-http-clj/java-http-clj {:mvn/version "0.4.3"}
funcool/promesa {:mvn/version "10.0.571"} funcool/promesa {:mvn/version "10.0.594"}
funcool/cuerdas {:mvn/version "2022.06.16-403"} funcool/cuerdas {:mvn/version "2022.06.16-403"}
lambdaisland/uri {:mvn/version "1.13.95" lambdaisland/uri {:mvn/version "1.13.95"

6
common/src/app/common/exceptions.cljc
View file

@ -89,9 +89,9 @@
(contains? data :explain)) (contains? data :explain))
(explain (:explain data) opts) (explain (:explain data) opts)
(and (::s/problems data) (and (contains? data ::s/problems)
(::s/value data) (contains? data ::s/value)
(::s/spec data)) (contains? data ::s/spec))
(binding [s/*explain-out* expound/printer] (binding [s/*explain-out* expound/printer]
(with-out-str (with-out-str
(s/explain-out (update data ::s/problems #(take max-problems %)))))))) (s/explain-out (update data ::s/problems #(take max-problems %))))))))

6
exporter/src/app/config.cljs
View file

@ -18,10 +18,10 @@
(def defaults (def defaults
{:public-uri "http://localhost:3449" {:public-uri "http://localhost:3449"
:tenant "dev" :tenant "default"
:host "devenv" :host "localhost"
:http-server-port 6061 :http-server-port 6061
:http-server-host "localhost" :http-server-host "0.0.0.0"
:redis-uri "redis://redis/0"}) :redis-uri "redis://redis/0"})
(s/def ::http-server-port ::us/integer) (s/def ::http-server-port ::us/integer)

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

@ -93,7 +93,7 @@
(->> (rx/from uris) (->> (rx/from uris)
(rx/filter (comp not svg-url?)) (rx/filter (comp not svg-url?))
(rx/map prepare) (rx/map prepare)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %)) (rx/mapcat #(rp/command! :create-file-media-object-from-url %))
(rx/do on-image)) (rx/do on-image))
(->> (rx/from uris) (->> (rx/from uris)

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

@ -466,9 +466,10 @@
{:name (extract-name uri) {:name (extract-name uri)
:url uri})))) :url uri}))))
(rx/mapcat (fn [uri-data] (rx/mapcat (fn [uri-data]
(->> (rp/mutation! (if (contains? uri-data :content) (->> (rp/command! (if (contains? uri-data :content)
:upload-file-media-object :upload-file-media-object
:create-file-media-object-from-url) uri-data) :create-file-media-object-from-url)
uri-data)
;; When the image uploaded fail we skip the shape ;; When the image uploaded fail we skip the shape
;; returning `nil` will afterward not create the shape. ;; returning `nil` will afterward not create the shape.
(rx/catch #(rx/of nil)) (rx/catch #(rx/of nil))