🎉 Add features assignation for teams

This commit is contained in:
Andrey Antukh 2023-10-23 19:31:41 +02:00 committed by Andrés Moya
parent 7db8d7b7ab
commit 6f93b41920
84 changed files with 2390 additions and 1777 deletions

View file

@ -21,7 +21,7 @@
[app.common.transit :as t]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.config :as cf]
[app.main :as main]
[app.srepl.helpers :as srepl.helpers]
[app.srepl.main :as srepl]
@ -96,7 +96,9 @@
(try
(alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys))
(-> (merge main/system-config main/worker-config)
(-> main/system-config
(cond-> (contains? cf/flags :backend-worker)
(merge main/worker-config))
(ig/prep)
(ig/init))))
:started

View file

@ -10,9 +10,10 @@ export PENPOT_FLAGS="\
enable-login-with-google \
enable-login-with-github \
enable-login-with-gitlab \
disable-backend-worker \
enable-backend-asserts \
enable-fdata-storage-pointer-map \
enable-fdata-storage-objets-map \
enable-feature-fdata-pointer-map \
enable-feature-fdata-objects-map \
enable-audit-log \
enable-transit-readable-response \
enable-demo-users \

View file

@ -231,60 +231,76 @@
`(jdbc/with-transaction ~@args)))
(defn open
[pool]
(jdbc/get-connection pool))
[system-or-pool]
(if (pool? system-or-pool)
(jdbc/get-connection system-or-pool)
(if (map? system-or-pool)
(open (::pool system-or-pool))
(ex/raise :type :internal
:code :unable-resolve-pool))))
(defn- resolve-connectable
(defn get-connection
[cfg-or-conn]
(if (connection? cfg-or-conn)
cfg-or-conn
(if (map? cfg-or-conn)
(get-connection (::conn cfg-or-conn))
(ex/raise :type :internal
:code :unable-resolve-connection
:hint "expected conn or system map"))))
(defn- get-connectable
[o]
(if (connection? o)
o
(if (pool? o)
o
(or (::conn o) (::pool o)))))
(cond
(connection? o) o
(pool? o) o
(map? o) (get-connectable (or (:conn o) (::pool o)))
:else (ex/raise :type :internal
:code :unable-resolve-connectable
:hint "expected conn, pool or system")))
(def ^:private default-opts
{:builder-fn sql/as-kebab-maps})
(defn exec!
([ds sv]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(jdbc/execute! sv default-opts)))
([ds sv opts]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(jdbc/execute! sv (merge default-opts opts)))))
(defn exec-one!
([ds sv]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(jdbc/execute-one! sv default-opts)))
([ds sv opts]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(jdbc/execute-one! sv
(-> (merge default-opts opts)
(assoc :return-keys (::return-keys? opts false)))))))
(defn insert!
[ds table params & {:as opts}]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(exec-one! (sql/insert table params opts)
(merge {::return-keys? true} opts))))
(defn insert-multi!
[ds table cols rows & {:as opts}]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(exec! (sql/insert-multi table cols rows opts)
(merge {::return-keys? true} opts))))
(defn update!
[ds table params where & {:as opts}]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(exec-one! (sql/update table params where opts)
(merge {::return-keys? true} opts))))
(defn delete!
[ds table params & {:as opts}]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(exec-one! (sql/delete table params opts)
(merge {::return-keys? true} opts))))
@ -318,7 +334,7 @@
(defn plan
[ds sql]
(-> (resolve-connectable ds)
(-> (get-connectable ds)
(jdbc/plan sql sql/default-opts)))
(defn get-by-id
@ -422,12 +438,16 @@
(release! conn sp)
result)
(catch Throwable cause
(rollback! sp)
(rollback! conn sp)
(throw cause))))
(::pool cfg)
(with-atomic [conn (::pool cfg)]
(f (assoc cfg ::conn conn)))
(let [result (f (assoc cfg ::conn conn))]
(when (::rollback cfg)
(l/dbg :hint "explicit rollback requested")
(rollback! conn))
result))
:else
(throw (IllegalArgumentException. "invalid arguments"))))

View file

@ -0,0 +1,677 @@
;; 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.features.components-v2
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.libraries-helpers :as cflh]
[app.common.files.migrations :as pmg]
[app.common.files.shapes-helpers :as cfsh]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.logging :as l]
[app.common.pages.changes :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.svg :as csvg]
[app.common.svg.shapes-builder :as sbuilder]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.db :as db]
[app.media :as media]
[app.rpc.commands.files :as files]
[app.rpc.commands.media :as cmd.media]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[buddy.core.codecs :as bc]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.exec.semaphore :as ps]))
;; - What about use of svgo on converting graphics to components
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; END PROMESA HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:dynamic *system* nil)
(def ^:dynamic *stats* nil)
(def ^:dynamic *semaphore* nil)
(def ^:dynamic *skip-on-error* true)
(def grid-gap 50)
(defn- prepare-file-data
"Apply some specific migrations or fixes to things that are allowed in v1 but not in v2,
or that are the result of old bugs."
[file-data libraries]
(let [detached-ids (volatile! #{})
detach-shape
(fn [container shape]
; Detach a shape. If it's inside a component, add it to detached-ids, for further use.
(let [is-component? (let [root-shape (ctst/get-shape container (:id container))]
(and (some? root-shape) (nil? (:parent-id root-shape))))]
(when is-component?
(vswap! detached-ids conj (:id shape)))
(ctk/detach-shape shape)))
fix-orphan-shapes
(fn [file-data]
; Find shapes that are not listed in their parent's children list.
; Remove them, and also their children
(letfn [(fix-container [container]
(reduce fix-shape container (ctn/shapes-seq container)))
(fix-shape
[container shape]
(if-not (or (= (:id shape) uuid/zero)
(nil? (:parent-id shape)))
(let [parent (ctst/get-shape container (:parent-id shape))
exists? (d/index-of (:shapes parent) (:id shape))]
(if (nil? exists?)
(let [ids (cph/get-children-ids-with-self (:objects container) (:id shape))]
(update container :objects #(reduce dissoc % ids)))
container))
container))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
remove-nested-roots
(fn [file-data]
; Remove :component-root in head shapes that are nested.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
(if (and (ctk/instance-root? shape)
(ctn/in-any-component? (:objects container) parent))
(dissoc shape :component-root)
shape)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
add-not-nested-roots
(fn [file-data]
; Add :component-root in head shapes that are not nested.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
(if (and (ctk/subinstance-head? shape)
(not (ctn/in-any-component? (:objects container) parent)))
(assoc shape :component-root true)
shape)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
fix-orphan-copies
(fn [file-data]
; Detach shapes that were inside a copy (have :shape-ref) but now they aren't.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
(if (and (ctk/in-component-copy? shape)
(not (ctk/instance-head? shape))
(not (ctk/in-component-copy? parent)))
(detach-shape container shape)
shape)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
remap-refs
(fn [file-data]
; Remap shape-refs so that they point to the near main.
; At the same time, if there are any dangling ref, detach the shape and its children.
(letfn [(fix-container [container]
(reduce fix-shape container (ctn/shapes-seq container)))
(fix-shape [container shape]
(if (ctk/in-component-copy? shape)
; First look for the direct shape.
(let [root (ctn/get-component-shape (:objects container) shape)
libraries (assoc-in libraries [(:id file-data) :data] file-data)
library (get libraries (:component-file root))
component (ctkl/get-component (:data library) (:component-id root) true)
direct-shape (ctf/get-component-shape (:data library) component (:shape-ref shape))]
(if (some? direct-shape)
; If it exists, there is nothing else to do.
container
; If not found, find the near shape.
(let [near-shape (d/seek #(= (:shape-ref %) (:shape-ref shape))
(ctf/get-component-shapes (:data library) component))]
(if (some? near-shape)
; If found, update the ref to point to the near shape.
(ctn/update-shape container (:id shape) #(assoc % :shape-ref (:id near-shape)))
; If not found, it may be a fostered component. Try to locate a direct shape
; in the head component.
(let [head (ctn/get-head-shape (:objects container) shape)
library-2 (get libraries (:component-file head))
component-2 (ctkl/get-component (:data library-2) (:component-id head) true)
direct-shape-2 (ctf/get-component-shape (:data library-2) component-2 (:shape-ref shape))]
(if (some? direct-shape-2)
; If it exists, there is nothing else to do.
container
; If not found, detach shape and all children (stopping if a nested instance is reached)
(let [children (ctn/get-children-in-instance (:objects container) (:id shape))]
(reduce #(ctn/update-shape %1 (:id %2) (partial detach-shape %1))
container
children))))))))
container))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
fix-copies-of-detached
(fn [file-data]
; Find any copy that is referencing a detached shape inside a component, and
; undo the nested copy, converting it into a direct copy.
(letfn [(fix-container [container]
(update container :objects update-vals fix-shape))
(fix-shape [shape]
(cond-> shape
(@detached-ids (:shape-ref shape))
(dissoc shape
:component-id
:component-file
:component-root)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))]
(-> file-data
(fix-orphan-shapes)
(remove-nested-roots)
(add-not-nested-roots)
(fix-orphan-copies)
(remap-refs)
(fix-copies-of-detached))))
(defn- migrate-components
"If there is any component in the file library, add a new 'Library
backup', generate main instances for all components there and remove
shapes from library components. Mark the file with
the :components-v2 option."
[file-data libraries]
(let [components (ctkl/components-seq file-data)]
(if (empty? components)
(assoc-in file-data [:options :components-v2] true)
(let [[file-data page-id start-pos]
(ctf/get-or-add-library-page file-data grid-gap)
migrate-component-shape
(fn [shape delta component-file component-id]
(cond-> shape
(nil? (:parent-id shape))
(assoc :parent-id uuid/zero
:main-instance true
:component-root true
:component-file component-file
:component-id component-id
:type :frame ; Old groups must be converted
:fills [] ; to frames and conform to spec
:hide-in-viewer true
:rx 0
:ry 0)
(nil? (:frame-id shape))
(assoc :frame-id uuid/zero)
:always
(gsh/move delta)))
add-main-instance
(fn [file-data component position]
(let [shapes (cph/get-children-with-self (:objects component)
(:id component))
root-shape (first shapes)
orig-pos (gpt/point (:x root-shape) (:y root-shape))
delta (gpt/subtract position orig-pos)
xf-shape (map #(migrate-component-shape %
delta
(:id file-data)
(:id component)))
new-shapes
(into [] xf-shape shapes)
add-shapes
(fn [page]
(reduce (fn [page shape]
(ctst/add-shape (:id shape)
shape
page
(:frame-id shape)
(:parent-id shape)
nil ; <- As shapes are ordered, we can safely add each
true)) ; one at the end of the parent's children list.
page
new-shapes))
update-component
(fn [component]
(-> component
(assoc :main-instance-id (:id root-shape)
:main-instance-page page-id)
(dissoc :objects)))]
(-> file-data
(ctpl/update-page page-id add-shapes)
(ctkl/update-component (:id component) update-component))))
add-instance-grid
(fn [fdata]
(let [components (->> fdata
(ctkl/components-seq)
(sort-by :name)
(reverse))
positions (ctst/generate-shape-grid
(map (partial ctf/get-component-root fdata) components)
start-pos
grid-gap)]
(reduce (fn [result [component position]]
(add-main-instance result component position))
fdata
(d/zip components positions))))]
(when (some? *stats*)
(let [total (count components)]
(swap! *stats* (fn [stats]
(-> stats
(update :processed/components (fnil + 0) total)
(assoc :current/components total))))))
(-> file-data
(prepare-file-data libraries)
(add-instance-grid))))))
(defn- create-shapes-for-bitmap
"Convert a media object that contains a bitmap image into shapes,
one shape of type :image and one group that contains it."
[{:keys [name width height id mtype]} position]
(let [group-shape (cts/setup-shape
{:type :frame
:x (:x position)
:y (:y position)
:width width
:height height
:name name
:frame-id uuid/zero
:parent-id uuid/zero})
img-shape (cts/setup-shape
{:type :image
:x (:x position)
:y (:y position)
:width width
:height height
:metadata {:id id
:width width
:height height
:mtype mtype}
:name name
:frame-id uuid/zero
:parent-id (:id group-shape)})]
[group-shape [img-shape]]))
(defn- parse-datauri
[data]
(let [[mtype b64-data] (str/split data ";base64," 2)
mtype (subs mtype (inc (str/index-of mtype ":")))
data (-> b64-data bc/str->bytes bc/b64->bytes)]
[mtype data]))
(defn- extract-name
[href]
(let [query-idx (d/nilv (str/last-index-of href "?") 0)
href (if (> query-idx 0) (subs href 0 query-idx) href)
filename (->> (str/split href "/") (last))
ext-idx (str/last-index-of filename ".")]
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn- collect-and-persist-images
[svg-data file-id]
(letfn [(process-image [{:keys [href] :as item}]
(try
(let [item (if (str/starts-with? href "data:")
(let [[mtype data] (parse-datauri href)
size (alength data)
path (tmp/tempfile :prefix "penpot.media.download.")
written (io/write-to-file! data path :size size)]
(when (not= written size)
(ex/raise :type :internal
:code :mismatch-write-size
:hint "unexpected state: unable to write to file"))
(-> item
(assoc :size size)
(assoc :path path)
(assoc :filename "tempfile")
(assoc :mtype mtype)))
(let [result (cmd.media/download-image *system* href)]
(-> (merge item result)
(assoc :name (extract-name href)))))]
;; The media processing adds the data to the
;; input map and returns it.
(media/run {:cmd :info :input item}))
(catch Throwable cause
(l/warn :hint "unexpected exception on processing internal image shape (skiping)"
:cause cause)
(when-not *skip-on-error*
(throw cause)))))
(persist-image [acc {:keys [path size width height mtype href] :as item}]
(let [storage (::sto/storage *system*)
conn (::db/conn *system*)
hash (sto/calculate-hash path)
content (-> (sto/content path size)
(sto/wrap-with-hash hash))
params {::sto/content content
::sto/deduplicate? true
::sto/touched-at (:ts item)
:content-type mtype
:bucket "file-media-object"}
image (sto/put-object! storage params)
fmo-id (uuid/next)]
(db/exec-one! conn
[cmd.media/sql:create-file-media-object
fmo-id
file-id true (:name item "image")
(:id image)
nil
width
height
mtype])
(assoc acc href {:id fmo-id
:mtype mtype
:width width
:height height})))
]
(let [images (->> (csvg/collect-images svg-data)
(transduce (keep process-image)
(completing persist-image) {}))]
(assoc svg-data :image-data images))))
(defn- get-svg-content
[id]
(let [storage (::sto/storage *system*)
conn (::db/conn *system*)
fmobject (db/get conn :file-media-object {:id id})
sobject (sto/get-object storage (:media-id fmobject))]
(with-open [stream (sto/get-object-data storage sobject)]
(slurp stream))))
(defn- create-shapes-for-svg
[{:keys [id] :as mobj} file-id objects position]
(let [svg-text (get-svg-content id)
svg-data (-> (csvg/parse svg-text)
(assoc :name (:name mobj))
(collect-and-persist-images file-id))]
(sbuilder/create-svg-shapes svg-data position objects uuid/zero nil #{} false)))
(defn- process-media-object
[fdata page-id mobj position]
(let [page (ctpl/get-page fdata page-id)
file-id (get fdata :id)
[shape children]
(if (= (:mtype mobj) "image/svg+xml")
(create-shapes-for-svg mobj file-id (:objects page) position)
(create-shapes-for-bitmap mobj position))
changes
(-> (pcb/empty-changes nil)
(pcb/set-save-undo? false)
(pcb/with-page page)
(pcb/with-objects (:objects page))
(pcb/with-library-data fdata)
(pcb/delete-media (:id mobj))
(pcb/add-objects (cons shape children)))
;; NOTE: this is a workaround for `generate-add-component`, it
;; is needed because that function always starts from empty
;; changes; so in this case we need manually add all shapes to
;; the page and then use that page for the
;; `generate-add-component` function
page
(reduce (fn [page shape]
(ctst/add-shape (:id shape)
shape
page
uuid/zero
uuid/zero
nil
true))
page
(cons shape children))
[_ _ changes2]
(cflh/generate-add-component nil
[shape]
(:objects page)
(:id page)
file-id
true
nil
cfsh/prepare-create-artboard-from-selection)
changes (pcb/concat-changes changes changes2)]
(cp/process-changes fdata (:redo-changes changes) false)))
(defn- migrate-graphics
[fdata]
(let [[fdata page-id position]
(ctf/get-or-add-library-page fdata grid-gap)
media (->> (vals (:media fdata))
(map (fn [{:keys [width height] :as media}]
(let [points (-> (grc/make-rect 0 0 width height)
(grc/rect->points))]
(assoc media :points points)))))
;; FIXME: think about what to do with existing media entries ??
grid (ctst/generate-shape-grid media position grid-gap)]
(when (some? *stats*)
(let [total (count media)]
(swap! *stats* (fn [stats]
(-> stats
(update :processed/graphics (fnil + 0) total)
(assoc :current/graphics total))))))
(->> (d/zip media grid)
(reduce (fn [fdata [mobj position]]
(try
(process-media-object fdata page-id mobj position)
(catch Throwable cause
(l/warn :hint "unable to process file media object (skiping)"
:file-id (str (:id fdata))
:id (str (:id mobj))
:cause cause)
(if-not *skip-on-error*
(throw cause)
fdata))))
fdata))))
(defn- migrate-file-data
[fdata libs]
(let [migrated? (dm/get-in fdata [:options :components-v2])]
(if migrated?
fdata
(let [fdata (migrate-components fdata libs)
fdata (migrate-graphics fdata)]
(update fdata :options assoc :components-v2 true)))))
(defn- process-file
[{:keys [id] :as file}]
(let [conn (::db/conn *system*)]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
cfeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objectd-map") omap/wrap identity)]
(let [libs (sequence
(map (fn [{:keys [id] :as lib}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(pmg/migrate-file)))))
(files/get-file-libraries conn id))
libs (-> (d/index-by :id libs)
(assoc (:id file) file))
file (-> file
(update :data blob/decode)
(update :data assoc :id id)
(update :data migrate-file-data libs)
(update :features conj "components/v2"))]
(when (contains? (:features file) "fdata/pointer-map")
(files/persist-pointers! conn id))
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)})
(dissoc file :data)))))
(defn migrate-file!
[system file-id]
(let [tpoint (dt/tpoint)
file-id (if (string? file-id)
(parse-uuid file-id)
file-id)]
(try
(l/dbg :hint "migrate:file:start" :file-id (str file-id))
(let [system (update system ::sto/storage media/configure-assets-storage)]
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
(binding [*system* system]
(-> (db/get conn :file {:id file-id})
(update :features db/decode-pgarray #{})
(process-file))))))
(finally
(let [elapsed (tpoint)
stats (some-> *stats* deref)]
(l/dbg :hint "migrate:file:end"
:file-id (str file-id)
:components (:current/components stats 0)
:graphics (:current/graphics stats 0)
:elapsed (dt/format-duration elapsed))
(when (some? *stats*)
(swap! *stats* (fn [stats]
(let [elapsed (inst-ms elapsed)
completed (inc (get stats :processed/files 0))
total (+ (get stats :elapsed/total-by-file 0) elapsed)
avg (/ (double elapsed) completed)]
(-> stats
(update :elapsed/max-by-file (fnil max 0) elapsed)
(assoc :elapsed/avg-by-file avg)
(assoc :elapsed/total-by-file total)
(assoc :processed/files completed)))))))))))
(defn migrate-team!
[system team-id]
(let [tpoint (dt/tpoint)
team-id (if (string? team-id)
(parse-uuid team-id)
team-id)]
(l/dbg :hint "migrate:team:start" :team-id (dm/str team-id))
(try
(db/tx-run! system
(fn [{:keys [::db/conn] :as system}]
;; Lock the team
(db/exec-one! conn ["SET idle_in_transaction_session_timeout = 0"])
(db/exec-one! conn ["UPDATE team SET features = array_append(features, 'ephimeral/v2-migration') WHERE id = ?" team-id])
(let [{:keys [features] :as team} (-> (db/get conn :team {:id team-id})
(update :features db/decode-pgarray #{}))]
(if (contains? features "components/v2")
(l/dbg :hint "team already migrated")
(let [sql (str/concat
"SELECT f.id FROM file AS f "
" JOIN project AS p ON (p.id = f.project_id) "
"WHERE p.team_id = ? AND f.deleted_at IS NULL AND p.deleted_at IS NULL "
"FOR UPDATE")
rows (->> (db/exec! conn [sql team-id])
(map :id))]
(run! (partial migrate-file! system) rows)
(some-> *stats* (swap! assoc :current/files (count rows)))
(let [features (-> features
(conj "components/v2")
(conj "layout/grid")
(conj "styles/v2"))]
(db/update! conn :team
{:features (db/create-array conn "text" features)}
{:id team-id})))))))
(finally
(some-> *semaphore* ps/release!)
(let [elapsed (tpoint)
stats (some-> *stats* deref)]
(l/dbg :hint "migrate:team:end"
:team-id (dm/str team-id)
:files (:current/files stats 0)
:elapsed (dt/format-duration elapsed))
(when (some? *stats*)
(swap! *stats* (fn [stats]
(let [elapsed (inst-ms elapsed)
completed (inc (get stats :processed/teams 0))
total (+ (get stats :elapsed/total-by-team 0) elapsed)
avg (/ (double elapsed) completed)]
(-> stats
(update :elapsed/max-by-team (fnil max 0) elapsed)
(assoc :elapsed/avg-by-team avg)
(assoc :elapsed/total-by-team total)
(assoc :processed/teams completed)))))))))))

View file

@ -0,0 +1,48 @@
;; 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.features.fdata
"A `fdata/*` related feature migration helpers"
(:require
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]))
(defn enable-objects-map
[file]
(-> file
(update :data (fn [data]
(-> data
(update :pages-index update-vals #(update % :objects omap/wrap))
(update :components update-vals #(update % :objects omap/wrap)))))
(update :features conj "fdata/objects-map")))
(defn enable-pointer-map
[file]
(-> file
(update :data (fn [data]
(-> data
(update :pages-index update-vals pmap/wrap)
(update :components pmap/wrap))))
(update :features conj "fdata/pointer-map")))
;; (defn enable-shape-data-type
;; [file]
;; (letfn [(update-object [object]
;; (-> object
;; (d/update-when :selrect grc/make-rect)
;; (d/update-when :svg-viewbox grc/make-rect)
;; (cts/map->Shape)))
;; (update-container [container]
;; (d/update-when container :objects update-vals update-object))]
;; (-> file
;; (update :data (fn [data]
;; (-> data
;; (update :pages-index update-vals update-container)
;; (update :components update-vals update-container))))
;; (update :features conj "fdata/shape-data-type"))))

View file

@ -333,6 +333,8 @@
{:name "0106-mod-file-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0106-mod-file-object-thumbnail-table.sql")}
{:name "0106-mod-team-table"
:fn (mg/resource "app/migrations/sql/0106-mod-team-table.sql")}
])
(defn apply-migrations!

View file

@ -0,0 +1 @@
ALTER TABLE team ADD COLUMN features text[] NULL DEFAULT null;

View file

@ -10,6 +10,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
@ -291,9 +292,12 @@
(defn create-profile-rels!
[conn {:keys [id] :as profile}]
(let [team (teams/create-team conn {:profile-id id
:name "Default"
:is-default true})]
(let [features (cfeat/get-enabled-features cf/flags)
team (teams/create-team conn
{:profile-id id
:name "Default"
:features features
:is-default true})]
(-> (db/update! conn :profile
{:default-team-id (:id team)
:default-project-id (:default-project-id team)}

View file

@ -8,10 +8,9 @@
(:refer-clojure :exclude [assert])
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.defaults :as cfd]
[app.common.files.features :as ffeat]
[app.common.files.migrations :as pmg]
[app.common.fressian :as fres]
[app.common.logging :as l]
@ -20,26 +19,30 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.components-v2 :as features.components-v2]
[app.features.fdata :as features.fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.media :as media]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.tasks.file-gc]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.set :as set]
[clojure.spec.alpha :as s]
[clojure.walk :as walk]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.util :as pu]
[yetti.adapter :as yt]
[yetti.response :as yrs])
(:import
@ -320,7 +323,7 @@
(defn- get-file-media
[{:keys [::db/pool]} {:keys [data id] :as file}]
(dm/with-open [conn (db/open pool)]
(pu/with-open [conn (db/open pool)]
(let [ids (app.tasks.file-gc/collect-used-media data)
ids (db/create-array conn "uuid" ids)
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")]
@ -354,7 +357,7 @@
(defn- get-libraries
[{:keys [::db/pool]} ids]
(dm/with-open [conn (db/open pool)]
(pu/with-open [conn (db/open pool)]
(let [ids (db/create-array conn "uuid" ids)]
(map :id (db/exec! pool [sql:file-libraries ids])))))
@ -366,7 +369,7 @@
" WHERE flr.file_id = ANY(?)")]
(db/exec! conn [sql ids])))))
(defn- create-or-update-file
(defn- create-or-update-file!
[conn params]
(let [sql (str "INSERT INTO file (id, project_id, name, revn, is_shared, data, created_at, modified_at) "
"VALUES (?, ?, ?, ?, ?, ?, ?, ?) "
@ -388,6 +391,7 @@
(def ^:dynamic *options* nil)
;; --- EXPORT WRITER
(defn- embed-file-assets
[data cfg file-id]
(letfn [(walk-map-form [form state]
@ -472,19 +476,19 @@
(defmethod write-export :default
[{:keys [::output] :as options}]
(write-header! output :v1)
(with-open [output (zstd-output-stream output :level 12)]
(with-open [output (io/data-output-stream output)]
(binding [*state* (volatile! {})]
(run! (fn [section]
(l/debug :hint "write section" :section section ::l/sync? true)
(write-label! output section)
(let [options (-> options
(assoc ::output output)
(assoc ::section section))]
(binding [*options* options]
(write-section options))))
(pu/with-open [output (zstd-output-stream output :level 12)
output (io/data-output-stream output)]
(binding [*state* (volatile! {})]
(run! (fn [section]
(l/dbg :hint "write section" :section section ::l/sync? true)
(write-label! output section)
(let [options (-> options
(assoc ::output output)
(assoc ::section section))]
(binding [*options* options]
(write-section options))))
[:v1/metadata :v1/files :v1/rels :v1/sobjects])))))
[:v1/metadata :v1/files :v1/rels :v1/sobjects]))))
(defmethod write-section :v1/metadata
[{:keys [::output ::file-ids ::include-libraries?] :as cfg}]
@ -506,23 +510,24 @@
(doseq [file-id (-> *state* deref :files)]
(let [detach? (and (not embed-assets?) (not include-libraries?))
file (cond-> (get-file cfg file-id)
detach?
(-> (ctf/detach-external-references file-id)
(dissoc :libraries))
embed-assets?
(update :data embed-file-assets cfg file-id))
file (cond-> (get-file cfg file-id)
detach?
(-> (ctf/detach-external-references file-id)
(dissoc :libraries))
embed-assets?
(update :data embed-file-assets cfg file-id))
media (get-file-media cfg file)]
media (get-file-media cfg file)]
(l/debug :hint "write penpot file"
:id file-id
:name (:name file)
:media (count media)
::l/sync? true)
(l/dbg :hint "write penpot file"
:id file-id
:name (:name file)
:features (:features file)
:media (count media)
::l/sync? true)
(doseq [item media]
(l/debug :hint "write penpot file media object" :id (:id item) ::l/sync? true))
(l/dbg :hint "write penpot file media object" :id (:id item) ::l/sync? true))
(doto output
(write-obj! file)
@ -535,7 +540,7 @@
(let [ids (-> *state* deref :files)
rels (when include-libraries?
(get-library-relations cfg ids))]
(l/debug :hint "found rels" :total (count rels) ::l/sync? true)
(l/dbg :hint "found rels" :total (count rels) ::l/sync? true)
(write-obj! output rels)))
(defmethod write-section :v1/sobjects
@ -543,21 +548,21 @@
(let [sids (-> *state* deref :sids)
storage (media/configure-assets-storage storage)]
(l/debug :hint "found sobjects"
:items (count sids)
::l/sync? true)
(l/dbg :hint "found sobjects"
:items (count sids)
::l/sync? true)
;; Write all collected storage objects
(write-obj! output sids)
(doseq [id sids]
(let [{:keys [size] :as obj} (sto/get-object storage id)]
(l/debug :hint "write sobject" :id id ::l/sync? true)
(l/dbg :hint "write sobject" :id id ::l/sync? true)
(doto output
(write-uuid! id)
(write-obj! (meta obj)))
(with-open [^InputStream stream (sto/get-object-data storage obj)]
(pu/with-open [stream (sto/get-object-data storage obj)]
(let [written (write-stream! output stream size)]
(when (not= written size)
(ex/raise :type :validation
@ -574,15 +579,16 @@
(defmulti read-import ::version)
(defmulti read-section ::section)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::input io/input-stream?)
(s/def ::overwrite? (s/nilable ::us/boolean))
(s/def ::migrate? (s/nilable ::us/boolean))
(s/def ::ignore-index-errors? (s/nilable ::us/boolean))
;; FIXME: replace with schema
(s/def ::read-import-options
(s/keys :req [::db/pool ::sto/storage ::project-id ::input]
:opt [::overwrite? ::migrate? ::ignore-index-errors?]))
(s/keys :req [::db/pool ::sto/storage ::project-id ::profile-id ::input]
:opt [::overwrite? ::ignore-index-errors?]))
(defn read-import!
"Do the importation of the specified resource in penpot custom binary
@ -592,9 +598,6 @@
`::overwrite?`: if true, instead of creating new files and remapping id references,
it reuses all ids and updates existing objects; defaults to `false`.
`::migrate?`: if true, applies the migration before persisting the
file data; defaults to `false`.
`::ignore-index-errors?`: if true, do not fail on index lookup errors, can
happen with broken files; defaults to: `false`.
"
@ -604,53 +607,95 @@
(let [version (read-header! input)]
(read-import (assoc options ::version version ::timestamp timestamp))))
(defmethod read-import :v1
[{:keys [::db/pool ::input] :as options}]
(with-open [input (zstd-input-stream input)]
(with-open [input (io/data-input-stream input)]
(db/with-atomic [conn pool]
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
(binding [*state* (volatile! {:media [] :index {}})]
(run! (fn [section]
(l/debug :hint "reading section" :section section ::l/sync? true)
(assert-read-label! input section)
(let [options (-> options
(assoc ::section section)
(assoc ::input input)
(assoc ::db/conn conn))]
(binding [*options* options]
(read-section options))))
[:v1/metadata :v1/files :v1/rels :v1/sobjects])
(defn- read-import-v1
[{:keys [::db/conn ::project-id ::profile-id ::input] :as options}]
(db/exec-one! conn ["SET idle_in_transaction_session_timeout = 0"])
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
;; Knowing that the ids of the created files are in
;; index, just lookup them and return it as a set
(let [files (-> *state* deref :files)]
(into #{} (keep #(get-in @*state* [:index %])) files)))))))
(pu/with-open [input (zstd-input-stream input)
input (io/data-input-stream input)]
(binding [*state* (volatile! {:media [] :index {}})]
(let [team (teams/get-team options
:profile-id profile-id
:project-id project-id)
features (cfeat/get-team-enabled-features cf/flags team)]
;; Process all sections
(run! (fn [section]
(l/dbg :hint "reading section" :section section ::l/sync? true)
(assert-read-label! input section)
(let [options (-> options
(assoc ::enabled-features features)
(assoc ::section section)
(assoc ::input input))]
(binding [*options* options]
(read-section options))))
[:v1/metadata :v1/files :v1/rels :v1/sobjects])
;; Run all pending migrations
(doseq [[feature file-id] (-> *state* deref :pending-to-migrate)]
(case feature
"components/v2"
(features.components-v2/migrate-file! options file-id)
"fdata/shape-data-type"
nil
;; "fdata/shape-data-type"
;; (features.fdata/enable-objects-map
(ex/raise :type :internal
:code :no-migration-defined
:hint (str/ffmt "no migation for feature '%' on file importation" feature)
:feature feature)))
;; Knowing that the ids of the created files are in index,
;; just lookup them and return it as a set
(let [files (-> *state* deref :files)]
(into #{} (keep #(get-in @*state* [:index %])) files))))))
(defmethod read-import :v1
[options]
(db/tx-run! options read-import-v1))
(defmethod read-section :v1/metadata
[{:keys [::input]}]
(let [{:keys [version files]} (read-obj! input)]
(l/debug :hint "metadata readed" :version (:full version) :files files ::l/sync? true)
(l/dbg :hint "metadata readed" :version (:full version) :files files ::l/sync? true)
(vswap! *state* update :index update-index files)
(vswap! *state* assoc :version version :files files)))
(defn- postprocess-file
[data]
(let [omap-wrap ffeat/*wrap-with-objects-map-fn*
pmap-wrap ffeat/*wrap-with-pointer-map-fn*]
(-> data
(update :pages-index update-vals #(update % :objects omap-wrap))
(update :pages-index update-vals pmap-wrap)
(update :components update-vals #(d/update-when % :objects omap-wrap))
(update :components pmap-wrap))))
[file]
(cond-> file
(and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(features.fdata/enable-objects-map)
(and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(features.fdata/enable-pointer-map)))
(defmethod read-section :v1/files
[{:keys [::db/conn ::input ::migrate? ::project-id ::timestamp ::overwrite?]}]
[{:keys [::db/conn ::input ::project-id ::enabled-features ::timestamp ::overwrite?]}]
(doseq [expected-file-id (-> *state* deref :files)]
(let [file (read-obj! input)
media' (read-obj! input)
file-id (:id file)
features (files/get-default-features)]
(let [file (read-obj! input)
media' (read-obj! input)
file-id (:id file)
file-id' (lookup-index file-id)
features (-> enabled-features
(set/difference cfeat/frontend-only-features)
(set/union (cfeat/check-supported-features! (:features file))))
]
;; All features that are enabled and requires explicit migration
;; are added to the state for a posterior migration step
(doseq [feature (-> enabled-features
(set/difference cfeat/no-migration-features)
(set/difference (:features file)))]
(vswap! *state* update :pending-to-migrate (fnil conj []) [feature file-id']))
(when (not= file-id expected-file-id)
(ex/raise :type :validation
@ -667,59 +712,54 @@
(l/dbg :hint "update media references" ::l/sync? true)
(vswap! *state* update :media into (map #(update % :id lookup-index)) media')
(binding [ffeat/*current* features
ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)
(binding [cfeat/*current* features
cfeat/*previous* (:features file)
pmap/*tracked* (atom {})]
(l/dbg :hint "processing file"
:id file-id
:features features
:features (:features file)
:version (-> file :data :version)
::l/sync? true)
(let [file-id' (lookup-index file-id)
data (-> (:data file)
(assoc :id file-id'))
(let [params (-> file
(assoc :id file-id')
(assoc :features features)
(assoc :project-id project-id)
(assoc :created-at timestamp)
(assoc :modified-at timestamp)
(update :data (fn [data]
(-> data
(assoc :id file-id')
(cond-> (> (:version data) cfd/version)
(assoc :version cfd/version))
data (if (> (:version data) cfd/version)
(assoc data :version cfd/version)
data)
;; FIXME: We're temporarily activating all
;; migrations because a problem in the
;; environments messed up with the version
;; numbers When this problem is fixed delete
;; the following line
(assoc :version 0)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(pmg/migrate-data))))
(postprocess-file)
(update :features #(db/create-array conn "text" %))
(update :data blob/encode))]
;; FIXME
;; We're temporarily activating all migrations because a problem in
;; the environments messed up with the version numbers
;; When this problem is fixed delete the following line
data (-> data (assoc :version 0))
data (-> data
(cond-> migrate? (pmg/migrate-data))
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(postprocess-file))
params {:id file-id'
:project-id project-id
:features (db/create-array conn "text" features)
:name (:name file)
:revn (:revn file)
:is-shared (:is-shared file)
:data (blob/encode data)
:created-at timestamp
:modified-at timestamp}]
(l/debug :hint "create file" :id file-id' ::l/sync? true)
(l/dbg :hint "create file" :id file-id' ::l/sync? true)
(if overwrite?
(create-or-update-file conn params)
(create-or-update-file! conn params)
(db/insert! conn :file params))
(files/persist-pointers! conn file-id')
(when overwrite?
(db/delete! conn :file-thumbnail {:file-id file-id'})))))))
(db/delete! conn :file-thumbnail {:file-id file-id'}))
file-id')))))
(defmethod read-section :v1/rels
[{:keys [::db/conn ::input ::timestamp]}]
@ -734,10 +774,10 @@
(if (contains? ids library-file-id)
(do
(l/debug :hint "create file library link"
:file-id (:file-id rel)
:lib-id (:library-file-id rel)
::l/sync? true)
(l/dbg :hint "create file library link"
:file-id (:file-id rel)
:lib-id (:library-file-id rel)
::l/sync? true)
(db/insert! conn :file-library-rel rel))
(l/warn :hint "ignoring file library link"
@ -759,7 +799,7 @@
:code :inconsistent-penpot-file
:hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"))
(l/debug :hint "readed storage object" :id id ::l/sync? true)
(l/dbg :hint "readed storage object" :id id ::l/sync? true)
(let [[size resource] (read-stream! input)
hash (sto/calculate-hash resource)
@ -773,14 +813,14 @@
sobject (sto/put-object! storage params)]
(l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true)
(l/dbg :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true)
(vswap! *state* update :index assoc id (:id sobject)))))
(doseq [item (:media @*state*)]
(l/debug :hint "inserting file media object"
:id (:id item)
:file-id (:file-id item)
::l/sync? true)
(l/dbg :hint "inserting file media object"
:id (:id item)
:file-id (:file-id item)
::l/sync? true)
(let [file-id (lookup-index (:file-id item))]
(if (= file-id (:file-id item))
@ -886,7 +926,7 @@
cs (volatile! nil)]
(try
(l/info :hint "start exportation" :export-id id)
(dm/with-open [output (io/output-stream output)]
(pu/with-open [output (io/output-stream output)]
(binding [*position* (atom 0)]
(write-export! (assoc cfg ::output output))))
@ -909,7 +949,7 @@
(defn export-to-tmpfile!
[cfg]
(let [path (tmp/tempfile :prefix "penpot.export.")]
(dm/with-open [output (io/output-stream path)]
(pu/with-open [output (io/output-stream path)]
(export! cfg output)
path)))
@ -921,7 +961,7 @@
(l/info :hint "import: started" :import-id id)
(try
(binding [*position* (atom 0)]
(dm/with-open [input (io/input-stream input)]
(pu/with-open [input (io/input-stream input)]
(read-import! (assoc cfg ::input input))))
(catch Throwable cause
@ -980,6 +1020,7 @@
(let [ids (import! (assoc cfg
::input (:path file)
::project-id project-id
::profile-id profile-id
::ignore-index-errors? true))]
(db/update! conn :project

View file

@ -9,11 +9,11 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.migrations :as pmg]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj]
[app.common.schema.generators :as sg]
[app.common.spec :as us]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
@ -43,23 +43,6 @@
(when media-id
(str (cf/get :public-uri) "/assets/by-id/" media-id)))
(def supported-features
#{"storage/objects-map"
"storage/pointer-map"
"internal/shape-record"
"internal/geom-record"
"components/v2"})
(defn get-default-features
[]
(cond-> #{"internal/shape-record"
"internal/geom-record"}
(contains? cf/flags :fdata-storage-pointer-map)
(conj "storage/pointer-map")
(contains? cf/flags :fdata-storage-objects-map)
(conj "storage/objects-map")))
;; --- SPECS
(s/def ::features ::us/set-of-strings)
@ -181,28 +164,10 @@
:code :object-not-found
:hint "not found"))))
;; --- HELPERS
(defn get-team-id
[conn project-id]
(:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FEATURES: pointer-map
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn check-features-compatibility!
"Function responsible to check if provided features are supported by
the current backend"
[features]
(let [not-supported (set/difference features supported-features)]
(when (seq not-supported)
(ex/raise :type :restriction
:code :features-not-supported
:feature (first not-supported)
:hint (format "features %s not supported" (str/join "," (map name not-supported)))))
features))
(defn load-pointer
[conn file-id id]
(let [row (db/get conn :file-data-fragment
@ -253,73 +218,16 @@
(into #{} (comp (filter pmap/pointer-map?)
(map pmap/get-id)))))
(declare get-file-libraries)
;; FIXME: file locking
(defn- process-components-v2-feature
"A special case handling of the components/v2 feature."
[conn {:keys [features data] :as file}]
(let [libraries (-> (->> (get-file-libraries conn (:id file)) ; This may be slow, but it's executed only once,
(map #(db/get conn :file {:id (:id %)})) ; in the migration to components-v2
(map #(update % :data blob/decode))
(d/index-by :id))
(assoc (:id file) file))
data (ctf/migrate-to-components-v2 data libraries)
features (conj features "components/v2")]
(-> file
(assoc ::pmg/migrated true)
(assoc :features features)
(assoc :data data))))
(defn handle-file-features!
[conn {:keys [features] :as file} client-features]
;; Check features compatibility between the currently supported features on
;; the current backend instance and the file retrieved from the database
(check-features-compatibility! features)
(cond-> file
(and (contains? features "components/v2")
(not (contains? client-features "components/v2")))
(as-> file (ex/raise :type :restriction
:code :feature-mismatch
:feature "components/v2"
:hint "file has 'components/v2' feature enabled but frontend didn't specifies it"
:file-id (:id file)))
;; This operation is needed because the components migration generates a new
;; page with random id which is returned to the client; without persisting
;; the migration this can cause that two simultaneous clients can have a
;; different view of the file data and end persisting two pages with main
;; components and breaking the whole file."
(and (contains? client-features "components/v2")
(not (contains? features "components/v2")))
(as-> file (process-components-v2-feature conn file))
;; This operation is needed for backward comapatibility with frontends that
;; does not support pointer-map resolution mechanism; this just resolves the
;; pointers on backend and return a complete file.
(and (contains? features "storage/pointer-map")
(not (contains? client-features "storage/pointer-map")))
(process-pointers deref)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUERY COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- COMMAND QUERY: get-file (by id)
(def schema:features
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (sg/subseq supported-features)}
::sm/set-of-strings])
(def schema:file
[:map {:title "File"}
[:id ::sm/uuid]
[:features schema:features]
[:features ::cfeat/features]
[:has-media-trimmed :boolean]
[:comment-thread-seqn {:min 0} :int]
[:name :string]
@ -341,18 +249,21 @@
(def schema:get-file
[:map {:title "get-file"}
[:features {:optional true} schema:features]
[:features {:optional true} ::cfeat/features]
[:id ::sm/uuid]
[:project-id {:optional true} ::sm/uuid]])
(defn get-file
([conn id client-features]
(get-file conn id client-features nil))
([conn id client-features project-id]
;; here we check if client requested features are supported
(check-features-compatibility! client-features)
([conn id] (get-file conn id nil))
([conn id project-id]
(dm/assert!
"expected raw connection"
(db/connection? conn))
(binding [pmap/*load-fn* (partial load-pointer conn id)
pmap/*tracked* (atom {})]
pmap/*tracked* (atom {})
cfeat/*new* (atom #{})]
(let [params (merge {:id id}
(when (some? project-id)
@ -360,22 +271,21 @@
file (-> (db/get conn :file params)
(decode-row)
(pmg/migrate-file))
file (handle-file-features! conn file client-features)]
(pmg/migrate-file))]
;; NOTE: when file is migrated, we break the rule of no perform
;; mutations on get operations and update the file with all
;; migrations applied
(when (pmg/migrated? file)
(let [features (db/create-array conn "text" (:features file))]
(if (pmg/migrated? file)
(let [features (set/union (deref cfeat/*new*) (:features file))]
(db/update! conn :file
{:data (blob/encode (:data file))
:features features}
:features (db/create-array conn "text" features)}
{:id id})
(persist-pointers! conn id)))
(persist-pointers! conn id)
(assoc file :features features))
file))))
file)))))
(defn get-minimal-file
[{:keys [::db/pool] :as cfg} id]
@ -392,14 +302,32 @@
::cond/key-fn get-file-etag
::sm/params schema:get-file
::sm/result schema:file-with-permissions}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features project-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id id)]
(check-read-permissions! perms)
(let [file (-> (get-file conn id features project-id)
(assoc :permissions perms))]
(vary-meta file assoc ::cond/key (get-file-etag params file))))))
[cfg {:keys [::rpc/profile-id id project-id] :as params}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(let [perms (get-permissions conn profile-id id)]
(check-read-permissions! perms)
(let [team (teams/get-team cfg
:profile-id profile-id
:project-id project-id
:file-id id)
file (-> (get-file conn id project-id)
(assoc :permissions perms))
_ (-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
;; This operation is needed for backward comapatibility with frontends that
;; does not support pointer-map resolution mechanism; this just resolves the
;; pointers on backend and return a complete file.
file (if (and (contains? (:features file) "fdata/pointer-map")
(not (contains? (:features params) "fdata/pointer-map")))
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(process-pointers file deref))
file)]
(vary-meta file assoc ::cond/key (get-file-etag params file)))))))
;; --- COMMAND QUERY: get-file-fragment (by id)
@ -422,7 +350,7 @@
(update :content blob/decode)))
(sv/defmethod ::get-file-fragment
"Retrieve a file by its ID. Only authenticated users."
"Retrieve a file fragment by its ID. Only authenticated users."
{::doc/added "1.17"
::sm/params schema:get-file-fragment
::sm/result schema:file-fragment}
@ -477,7 +405,6 @@
(projects/check-read-permissions! conn profile-id project-id)
(get-project-files conn project-id)))
;; --- COMMAND QUERY: has-file-libraries
(declare get-has-file-libraries)
@ -528,30 +455,41 @@
(update page :objects update-vals #(dissoc % :thumbnail)))
(defn get-page
[conn {:keys [file-id page-id object-id features]}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id] :as params}]
(when (and (uuid? object-id)
(not (uuid? page-id)))
(ex/raise :type :validation
:code :params-validation
:hint "page-id is required when object-id is provided"))
(let [file (get-file conn file-id features)
page-id (or page-id (-> file :data :pages first))
page (dm/get-in file [:data :pages-index page-id])
page (if (pmap/pointer-map? page)
(let [team (teams/get-team cfg
:profile-id profile-id
:file-id file-id)
file (get-file conn file-id)
_ (-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
page (binding [pmap/*load-fn* (partial load-pointer conn file-id)]
(let [page-id (or page-id (-> file :data :pages first))
page (dm/get-in file [:data :pages-index page-id])]
(if (pmap/pointer-map? page)
(deref page)
page)]
page)))]
(cond-> (prune-thumbnails page)
(uuid? object-id)
(prune-objects object-id))))
(def schema:get-page
[:map {:title "GetPage"}
[:map {:title "get-page"}
[:file-id ::sm/uuid]
[:page-id {:optional true} ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]
[:object-id {:optional true} ::sm/uuid]
[:features {:optional true} schema:features]])
[:features {:optional true} ::cfeat/features]])
(sv/defmethod ::get-page
"Retrieves the page data from file and returns it. If no page-id is
@ -565,12 +503,11 @@
Mainly used for rendering purposes."
{::doc/added "1.17"
::sm/params schema:get-page}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
(dm/with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id file-id share-id)]
(check-read-permissions! perms)
(binding [pmap/*load-fn* (partial load-pointer conn file-id)]
(get-page conn params)))))
[cfg {:keys [::rpc/profile-id file-id share-id] :as params}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(check-read-permissions! conn profile-id file-id share-id)
(get-page cfg (assoc params :profile-id profile-id)))))
;; --- COMMAND QUERY: get-team-shared-files
@ -593,6 +530,7 @@
and p.team_id = ?
order by f.modified_at desc")
;; FIXME: i'm not sure about feature handling here... ???
(defn get-team-shared-files
[conn team-id]
(letfn [(assets-sample [assets limit]
@ -626,19 +564,19 @@
(map #(assoc % :library-summary (library-summary %)))
(map #(dissoc % :data)))))))
(s/def ::get-team-shared-files
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-team-shared-files
[:map {:title "get-team-shared-files"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-team-shared-files
"Get all file (libraries) for the specified team."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-shared-files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(get-team-shared-files conn team-id)))
;; --- COMMAND QUERY: get-file-libraries
(def ^:private sql:get-file-libraries
@ -669,17 +607,20 @@
[conn file-id]
(into []
(comp
;; FIXME: :is-indirect set to false to all rows looks
;; completly useless
(map #(assoc % :is-indirect false))
(map decode-row))
(db/exec! conn [sql:get-file-libraries file-id])))
(s/def ::get-file-libraries
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]))
(def ^:private schema:get-file-libraries
[:map {:title "get-file-libraries"}
[:file-id ::sm/uuid]])
(sv/defmethod ::get-file-libraries
"Get libraries used by the specified file."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-file-libraries}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
@ -700,12 +641,14 @@
[conn file-id]
(db/exec! conn [sql:library-using-files file-id]))
(s/def ::get-library-file-references
(s/keys :req [::rpc/profile-id] :req-un [::file-id]))
(def ^:private schema:get-library-file-references
[:map {:title "get-library-file-references"}
[:file-id ::sm/uuid]])
(sv/defmethod ::get-library-file-references
"Returns all the file references that use specified file (library) id."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-library-file-references}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
@ -745,12 +688,13 @@
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(dissoc row :media-id))))))
(s/def ::get-team-recent-files
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-team-recent-files
[:map {:title "get-team-recent-files"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-team-recent-files
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-recent-files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
@ -763,15 +707,26 @@
"Retrieve a file summary by its ID. Only authenticated users."
{::doc/added "1.20"
::sm/params schema:get-file}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features project-id] :as params}]
(db/with-atomic [conn pool]
(check-read-permissions! conn profile-id id)
(let [file (get-file conn id features project-id)]
{:name (:name file)
:components-count (count (ctkl/components-seq (:data file)))
:graphics-count (count (get-in file [:data :media] []))
:colors-count (count (get-in file [:data :colors] []))
:typography-count (count (get-in file [:data :typographies] []))})))
[cfg {:keys [::rpc/profile-id id project-id] :as params}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(check-read-permissions! conn profile-id id)
(let [team (teams/get-team cfg
:profile-id profile-id
:project-id project-id
:file-id id)
file (get-file conn id project-id)]
(-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
{:name (:name file)
:components-count (count (ctkl/components-seq (:data file)))
:graphics-count (count (get-in file [:data :media] []))
:colors-count (count (get-in file [:data :colors] []))
:typography-count (count (get-in file [:data :typographies] []))}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS
@ -927,13 +882,15 @@
[conn {:keys [file-id library-id] :as params}]
(db/exec-one! conn [sql:link-file-to-library file-id library-id]))
(s/def ::link-file-to-library
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::library-id]))
(def ^:private schema:link-file-to-library
[:map {:title "link-file-to-library"}
[:file-id ::sm/uuid]
[:library-id ::sm/uuid]])
(sv/defmethod ::link-file-to-library
{::doc/added "1.17"
::webhooks/event? true}
::webhooks/event? true
::sm/params schema:link-file-to-library}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id library-id] :as params}]
(when (= file-id library-id)
(ex/raise :type :validation
@ -952,13 +909,15 @@
{:file-id file-id
:library-file-id library-id}))
(s/def ::unlink-file-from-library
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::library-id]))
(def ^:private schema:unlink-file-to-library
[:map {:title "unlink-file-to-library"}
[:file-id ::sm/uuid]
[:library-id ::sm/uuid]])
(sv/defmethod ::unlink-file-from-library
{::doc/added "1.17"
::webhooks/event? true}
::webhooks/event? true
::sm/params schema:unlink-file-to-library}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)
@ -974,15 +933,15 @@
{:file-id file-id
:library-file-id library-id}))
(s/def ::update-file-library-sync-status
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::library-id]))
;; TODO: improve naming
(def ^:private schema:update-file-library-sync-status
[:map {:title "update-file-library-sync-status"}
[:file-id ::sm/uuid]
[:library-id ::sm/uuid]])
(sv/defmethod ::update-file-library-sync-status
"Update the synchronization status of a file->library link"
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-file-library-sync-status}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)

View file

@ -7,15 +7,18 @@
(ns app.rpc.commands.files-create
(:require
[app.common.data :as d]
[app.common.files.features :as ffeat]
[app.common.features :as cfeat]
[app.common.schema :as sm]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.permissions :as perms]
[app.rpc.quotes :as quotes]
@ -24,7 +27,7 @@
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
[clojure.set :as set]))
(defn create-file-role!
[conn {:keys [file-id profile-id role]}]
@ -34,27 +37,27 @@
(db/insert! conn :file-profile-rel))))
(defn create-file
[conn {:keys [id name project-id is-shared revn
modified-at deleted-at create-page
ignore-sync-until features]
:or {is-shared false revn 0 create-page true}
:as params}]
[{:keys [::db/conn] :as cfg}
{:keys [id name project-id is-shared revn
modified-at deleted-at create-page
ignore-sync-until features]
:or {is-shared false revn 0 create-page true}
:as params}]
(let [id (or id (uuid/next))
features (->> features
(into (files/get-default-features))
(files/check-features-compatibility!))
pointers (atom {})
data (binding [pmap/*tracked* pointers
ffeat/*current* features
ffeat/*wrap-with-objects-map-fn* (if (features "storate/objects-map") omap/wrap identity)
ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)]
cfeat/*current* features
cfeat/*wrap-with-objects-map-fn* (if (features "fdata/objects-map") omap/wrap identity)
cfeat/*wrap-with-pointer-map-fn* (if (features "fdata/pointer-map") pmap/wrap identity)]
(if create-page
(ctf/make-file-data id)
(ctf/make-file-data id nil)))
features (db/create-array conn "text" features)
features (->> (set/difference features cfeat/frontend-only-features)
(db/create-array conn "text"))
file (db/insert! conn :file
(d/without-nils
{:id id
@ -80,29 +83,58 @@
(files/decode-row file)))
(s/def ::create-file
(s/keys :req [::rpc/profile-id]
:req-un [::files/name
::files/project-id]
:opt-un [::files/id
::files/is-shared
::files/features]))
(def ^:private schema:create-file
[:map {:title "create-file"}
[:name :string]
[:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid]
[:is-shared {:optional true} :boolean]
[:features {:optional true} ::cfeat/features]])
(sv/defmethod ::create-file
{::doc/added "1.17"
::doc/module :files
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
(db/with-atomic [conn pool]
(projects/check-edition-permissions! conn profile-id project-id)
(let [team-id (files/get-team-id conn project-id)
params (assoc params :profile-id profile-id)]
::webhooks/event? true
::sm/params schema:create-file}
[cfg {:keys [::rpc/profile-id project-id] :as params}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(projects/check-edition-permissions! conn profile-id project-id)
(let [team (teams/get-team cfg
:profile-id profile-id
:project-id project-id)
team-id (:id team)
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/files-per-project
::quotes/team-id team-id
::quotes/profile-id profile-id
::quotes/project-id project-id}))
;; When we create files, we only need to respect the team
;; features, because some features can be enabled
;; globally, but the team is still not migrated properly.
features (-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params)))
(-> (create-file conn params)
(vary-meta assoc ::audit/props {:team-id team-id})))))
;; We also include all no migration features declared by
;; client; that enables the ability to enable a runtime
;; feature on frontend and make it permanent on file
features (-> (:features params #{})
(set/intersection cfeat/no-migration-features)
(set/union features))
params (-> params
(assoc :profile-id profile-id)
(assoc :features features))]
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/files-per-project
::quotes/team-id team-id
::quotes/profile-id profile-id
::quotes/project-id project-id}))
;; When newly computed features does not match exactly with
;; the features defined on team row, we update it.
(when (not= features (:features team))
(let [features (db/create-array conn "text" features)]
(db/update! conn :team
{:features features}
{:id team-id})))
(-> (create-file cfg params)
(vary-meta assoc ::audit/props {:team-id team-id}))))))

View file

@ -9,12 +9,14 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.thumbnails :as thc]
[app.common.types.shape-tree :as ctt]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.loggers.audit :as-alias audit]
@ -22,6 +24,7 @@
[app.media :as media]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams]
[app.rpc.cond :as-alias cond]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
@ -237,7 +240,7 @@
(def ^:private schema:get-file-data-for-thumbnail
[:map {:title "get-file-data-for-thumbnail"}
[:file-id ::sm/uuid]
[:features {:optional true} files/schema:features]])
[:features {:optional true} ::cfeat/features]])
(def ^:private schema:partial-file
[:map {:title "PartialFile"}
@ -252,17 +255,23 @@
::doc/module :files
::sm/params schema:get-file-data-for-thumbnail
::sm/result schema:partial-file}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
(dm/with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id)
;; NOTE: we force here the "storage/pointer-map" feature, because
;; it used internally only and is independent if user supports it
;; or not.
(let [feat (into #{"storage/pointer-map"} features)
file (files/get-file conn file-id feat)]
{:file-id file-id
:revn (:revn file)
:page (get-file-data-for-thumbnail conn file)})))
[cfg {:keys [::rpc/profile-id file-id] :as params}]
(db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-read-permissions! conn profile-id file-id)
(let [team (teams/get-team cfg
:profile-id profile-id
:file-id file-id)
file (files/get-file conn file-id)]
(-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
{:file-id file-id
:revn (:revn file)
:page (get-file-data-for-thumbnail conn file)}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS

View file

@ -8,18 +8,17 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.files.features :as ffeat]
[app.common.features :as cfeat]
[app.common.files.migrations :as pmg]
[app.common.files.validate :as val]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.pages.changes :as cpc]
[app.common.schema :as sm]
[app.common.schema.generators :as smg]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :refer [enable-pointer-map enable-objects-map]]
[app.loggers.audit :as audit]
[app.loggers.webhooks :as webhooks]
[app.metrics :as mtx]
@ -27,43 +26,42 @@
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit]
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]))
[app.util.time :as dt]
[clojure.set :as set]))
;; --- SCHEMA
(sm/def! ::changes
(def ^:private schema:changes
[:vector ::cpc/change])
(sm/def! ::change-with-metadata
(def ^:private schema:change-with-metadata
[:map {:title "ChangeWithMetadata"}
[:changes ::changes]
[:changes schema:changes]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]])
(sm/def! ::update-file-params
[:map {:title "UpdateFileParams"}
(def ^:private schema:update-file
[:map {:title "update-file"}
[:id ::sm/uuid]
[:session-id ::sm/uuid]
[:revn {:min 0} :int]
[:features {:optional true
:gen/max 3
:gen/gen (smg/subseq files/supported-features)}
::sm/set-of-strings]
[:changes {:optional true} ::changes]
[:features {:optional true} ::cfeat/features]
[:changes {:optional true} schema:changes]
[:changes-with-metadata {:optional true}
[:vector ::change-with-metadata]]
[:vector schema:change-with-metadata]]
[:skip-validate {:optional true} :boolean]])
(sm/def! ::update-file-result
[:vector {:title "UpdateFileResults"}
[:map {:title "UpdateFileResult"}
[:changes ::changes]
(def ^:private schema:update-file-result
[:vector {:title "update-file-result"}
[:map
[:changes schema:changes]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} :int]
@ -112,7 +110,7 @@
(fn [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
ffeat/*wrap-with-pointer-map-fn* pmap/wrap]
cfeat/*wrap-with-pointer-map-fn* pmap/wrap]
(let [result (f cfg file)]
(files/persist-pointers! conn id)
result))))
@ -120,7 +118,7 @@
(defn- wrap-with-objects-map-context
[f]
(fn [cfg file]
(binding [ffeat/*wrap-with-objects-map-fn* omap/wrap]
(binding [cfeat/*wrap-with-objects-map-fn* omap/wrap]
(f cfg file))))
(declare get-lagged-changes)
@ -141,81 +139,95 @@
::webhooks/batch-timeout (dt/duration "2m")
::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
::sm/params ::update-file-params
::sm/result ::update-file-result
::sm/params schema:update-file
::sm/result schema:update-file-result
::doc/module :files
::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(db/xact-lock! conn id)
[cfg {:keys [::rpc/profile-id id] :as params}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id id)
(db/xact-lock! conn id)
(let [cfg (assoc cfg ::db/conn conn)
params (assoc params :profile-id profile-id)
tpoint (dt/tpoint)]
(-> (update-file cfg params)
(rph/with-defer #(let [elapsed (tpoint)]
(l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
(let [file (get-file conn id)
team (teams/get-team cfg
:profile-id profile-id
:team-id (:team-id file))
features (-> (cfeat/get-team-enabled-features cf/flags team)
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
params (assoc params
:profile-id profile-id
:features features
:team team
:file file)
tpoint (dt/tpoint)]
;; When newly computed features does not match exactly with
;; the features defined on team row, we update it.
(when (not= features (:features team))
(let [features (db/create-array conn "text" features)]
(db/update! conn :team
{:features features}
{:id (:id team)})))
(-> (update-file cfg params)
(rph/with-defer #(let [elapsed (tpoint)]
(l/trace :hint "update-file" :time (dt/format-duration elapsed)))))))))
(defn update-file
[{:keys [::db/conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata skip-validate] :as params}]
(let [file (get-file conn id)
features (->> (concat (:features file)
(:features params))
(into (files/get-default-features))
(files/check-features-compatibility!))]
[{:keys [::db/conn ::mtx/metrics] :as cfg} {:keys [id file features changes changes-with-metadata skip-validate] :as params}]
(binding [cfeat/*current* features
cfeat/*previous* (:features file)]
(let [update-fn (cond-> update-file*
(contains? features "fdata/pointer-map")
(wrap-with-pointer-map-context)
(files/check-edition-permissions! conn profile-id (:id file))
(contains? features "fdata/objects-map")
(wrap-with-objects-map-context))
(binding [ffeat/*current* features
ffeat/*previous* (:features file)]
;; TODO: this ruins performance.
;; We must find some other way to do general validation.
libraries (when (and (contains? cf/flags :file-validation)
(not skip-validate))
(let [libs (->> (files/get-file-libraries conn (:id file))
(map #(get-file conn (:id %)))
(map #(update % :data blob/decode))
(d/index-by :id))]
(assoc libs (:id file) file)))
(let [update-fn (cond-> update-file*
(contains? features "storage/pointer-map")
(wrap-with-pointer-map-context)
changes (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))
(contains? features "storage/objects-map")
(wrap-with-objects-map-context))
features (-> features
(set/difference cfeat/frontend-only-features)
(set/union (:features file)))]
file (assoc file :features features)
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
;; TODO: this ruins performance.
;; We must find some other way to do general validation.
libraries (when (and (cf/flags :file-validation)
(not skip-validate))
(-> (->> (files/get-file-libraries conn (:id file))
(map #(get-file conn (:id %)))
(map #(update % :data blob/decode))
(d/index-by :id))
(assoc (:id file) file)))
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
changes (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))
params (-> params
(assoc :file file)
(assoc :libraries libraries)
(assoc :changes changes)
(assoc ::created-at (dt/now)))]
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
(when (not= features (:features file))
(let [features (db/create-array conn "text" features)]
(db/update! conn :file
{:features features}
{:id id})))
(when (not= features (:features file))
(let [features (db/create-array conn "text" features)]
(db/update! conn :file
{:features features}
{:id id})))
(let [file (assoc file :features features)
params (-> params
(assoc :file file)
(assoc :libraries libraries)
(assoc :changes changes)
(assoc ::created-at (dt/now)))]
(-> (update-fn cfg params)
(vary-meta assoc ::audit/replace-props
{:id (:id file)
@ -230,7 +242,7 @@
;; to be executed on a separated executor for avoid to do the
;; CPU intensive operation on vthread.
file (-> (climit/configure cfg :update-file)
(climit/submit! (partial update-file-data conn file libraries changes skip-validate)))]
(climit/submit! (partial update-file-data file libraries changes skip-validate)))]
(db/insert! conn :file-change
{:id (uuid/next)
@ -264,39 +276,36 @@
(get-lagged-changes conn params))))
(defn- update-file-data
[conn file libraries changes skip-validate]
[file libraries changes skip-validate]
(let [validate (fn [file]
(when (and (cf/flags :file-validation)
(not skip-validate))
(val/validate-file file libraries :throw? true)))
do-migrate-v2 (fn [file]
;; When migrating to components-v2 we need the libraries even
;; if the validations are disabled.
(let [libraries (or (seq libraries)
(-> (->> (files/get-file-libraries conn (:id file))
(map #(get-file conn (:id %)))
(map #(update % :data blob/decode))
(d/index-by :id))
(assoc (:id file) file)))]
(ctf/migrate-to-components-v2 file libraries)))]
(-> file
(update :revn inc)
(update :data (fn [data]
(cond-> data
:always
(-> (blob/decode)
(assoc :id (:id file))
(pmg/migrate-data))
file (-> file
(update :revn inc)
(update :data (fn [data]
(cond-> data
:always
(-> (blob/decode)
(assoc :id (:id file))
(pmg/migrate-data))
(and (contains? ffeat/*current* "components/v2")
(not (contains? ffeat/*previous* "components/v2")))
(do-migrate-v2)
:always
(cp/process-changes changes))))
(d/tap-r validate))
:always
(cp/process-changes changes))))
(d/tap-r validate)
(update :data blob/encode))))
file (if (and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(enable-objects-map file)
file)
file (if (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(enable-pointer-map file)
file)
]
(update file :data blob/encode)))
(defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved."
@ -325,7 +334,7 @@
(vec)))
(defn- send-notifications!
[{:keys [::db/conn] :as cfg} {:keys [file changes session-id] :as params}]
[cfg {:keys [file team changes session-id] :as params}]
(let [lchanges (filter library-change? changes)
msgbus (::mbus/msgbus cfg)]
@ -339,14 +348,12 @@
:changes changes})
(when (and (:is-shared file) (seq lchanges))
(let [team-id (or (:team-id file)
(files/get-team-id conn (:project-id file)))]
(mbus/pub! msgbus
:topic team-id
:message {:type :library-change
:profile-id (:profile-id params)
:file-id (:id file)
:session-id session-id
:revn (:revn file)
:modified-at (dt/now)
:changes lchanges})))))
(mbus/pub! msgbus
:topic (:id team)
:message {:type :library-change
:profile-id (:profile-id params)
:file-id (:id file)
:session-id session-id
:revn (:revn file)
:modified-at (dt/now)
:changes lchanges}))))

View file

@ -78,13 +78,13 @@
::audit/profile-id (:id profile)}))))))
(defn- login-or-register
[{:keys [::db/pool] :as cfg} info]
(db/with-atomic [conn pool]
(or (some->> (:email info)
(profile/get-profile-by-email conn)
(profile/decode-row))
(->> (assoc info :is-active true :is-demo false)
(auth/create-profile! conn)
(auth/create-profile-rels! conn)
(profile/strip-private-attrs)))))
[cfg info]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(or (some->> (:email info)
(profile/get-profile-by-email conn)
(profile/decode-row))
(->> (assoc info :is-active true :is-demo false)
(auth/create-profile! conn)
(auth/create-profile-rels! conn)
(profile/strip-private-attrs))))))

View file

@ -9,9 +9,9 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.migrations :as pmg]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.loggers.webhooks :as-alias webhooks]
@ -27,7 +27,6 @@
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.walk :as walk]
[promesa.exec :as px]))
@ -35,21 +34,16 @@
(declare duplicate-file)
(s/def ::id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::duplicate-file
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]
:opt-un [::name]))
(def ^:private schema:duplicate-file
[:map {:title "duplicate-file"}
[:file-id ::sm/uuid]
[:name {:optional true} :string]])
(sv/defmethod ::duplicate-file
"Duplicate a single file in the same team."
{::doc/added "1.16"
::webhooks/event? true}
::webhooks/event? true
::sm/params schema:duplicate-file}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(duplicate-file conn (assoc params :profile-id profile-id))))
@ -125,14 +119,14 @@
(files/persist-pointers! conn file-id)
data)))))))
(def sql:retrieve-used-libraries
(def sql:get-used-libraries
"select flr.*
from file_library_rel as flr
inner join file as l on (flr.library_file_id = l.id)
where flr.file_id = ?
and l.deleted_at is null")
(def sql:retrieve-used-media-objects
(def sql:get-used-media-objects
"select fmo.*
from file_media_object as fmo
inner join storage_object as so on (fmo.media_id = so.id)
@ -141,8 +135,8 @@
(defn duplicate-file*
[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)]))
fmeds (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
(let [flibs (or flibs (db/exec! conn [sql:get-used-libraries (:id file)]))
fmeds (or fmeds (db/exec! conn [sql:get-used-media-objects (:id file)]))
;; memo uniform creation/modification date
now (dt/now)
@ -216,15 +210,16 @@
(declare duplicate-project)
(s/def ::duplicate-project
(s/keys :req [::rpc/profile-id]
:req-un [::project-id]
:opt-un [::name]))
(def ^:private schema:duplicate-project
[:map {:title "duplicate-project"}
[:project-id ::sm/uuid]
[:name {:optional true} :string]])
(sv/defmethod ::duplicate-project
"Duplicate an entire project with all the files"
{::doc/added "1.16"
::webhooks/event? true}
::webhooks/event? true
::sm/params schema:duplicate-project}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(duplicate-project conn (assoc params :profile-id (::rpc/profile-id params)))))
@ -275,7 +270,7 @@
;; --- COMMAND: Move file
(def sql:retrieve-files
(def sql:get-files
"select id, project_id from file where id = ANY(?)")
(def sql:move-files
@ -297,14 +292,19 @@
and rel.library_file_id = br.library_file_id")
(defn move-files
[conn {:keys [profile-id ids project-id] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id ids project-id] :as params}]
(let [fids (db/create-array conn "uuid" ids)
files (db/exec! conn [sql:retrieve-files fids])
files (db/exec! conn [sql:get-files fids])
source (into #{} (map :project-id) files)
pids (->> (conj source project-id)
(db/create-array conn "uuid"))]
(when (contains? source project-id)
(ex/raise :type :validation
:code :cant-move-to-same-project
:hint "Unable to move a file to the same project"))
;; Check if we have permissions on the destination project
(proj/check-edition-permissions! conn profile-id project-id)
@ -312,10 +312,10 @@
(doseq [project-id source]
(proj/check-edition-permissions! conn profile-id project-id))
(when (contains? source project-id)
(ex/raise :type :validation
:code :cant-move-to-same-project
:hint "Unable to move a file to the same project"))
;; Check the team compatibility
(let [orig-team (teams/get-team cfg :profile-id profile-id :project-id (first source))
dest-team (teams/get-team cfg :profile-id profile-id :project-id project-id)]
(cfeat/check-teams-compatibility! orig-team dest-team))
;; move all files to the project
(db/exec-one! conn [sql:move-files project-id fids])
@ -337,36 +337,41 @@
nil))
(s/def ::ids (s/every ::us/uuid :kind set?))
(s/def ::move-files
(s/keys :req [::rpc/profile-id]
:req-un [::ids ::project-id]))
(def ^:private schema:move-files
[:map {:title "move-files"}
[:ids ::sm/set-of-uuid]
[:project-id ::sm/uuid]])
(sv/defmethod ::move-files
"Move a set of files from one project to other."
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(move-files conn (assoc params :profile-id profile-id))))
::webhooks/event? true
::sm/params schema:move-files}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg #(move-files % (assoc params :profile-id profile-id))))
;; --- COMMAND: Move project
(defn move-project
[conn {:keys [profile-id team-id project-id] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile-id team-id project-id] :as params}]
(let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})
pids (->> (db/query conn :project {:team-id (:team-id project)} {:columns [:id]})
(map :id)
(db/create-array conn "uuid"))]
(teams/check-edition-permissions! conn profile-id (:team-id project))
(teams/check-edition-permissions! conn profile-id team-id)
(when (= team-id (:team-id project))
(ex/raise :type :validation
:code :cant-move-to-same-team
:hint "Unable to move a project to same team"))
(teams/check-edition-permissions! conn profile-id (:team-id project))
(teams/check-edition-permissions! conn profile-id team-id)
;; Check the teams compatibility
(let [orig-team (teams/get-team cfg :profile-id profile-id :team-id (:team-id project))
dest-team (teams/get-team cfg :profile-id profile-id :team-id team-id)]
(cfeat/check-teams-compatibility! orig-team dest-team))
;; move project to the destination team
(db/update! conn :project
{:team-id team-id}
@ -377,17 +382,18 @@
nil))
(s/def ::move-project
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::project-id]))
(def ^:private schema:move-project
[:map {:title "move-project"}
[:team-id ::sm/uuid]
[:project-id ::sm/uuid]])
(sv/defmethod ::move-project
"Move projects between teams."
"Move projects between teams"
{::doc/added "1.16"
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(move-project conn (assoc params :profile-id profile-id))))
::webhooks/event? true
::sm/params schema:move-project}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg #(move-project % (assoc params :profile-id profile-id))))
;; --- COMMAND: Clone Template
@ -409,6 +415,7 @@
(dissoc ::db/conn)
(assoc ::binfile/input template)
(assoc ::binfile/project-id (:id project))
(assoc ::binfile/profile-id profile-id)
(assoc ::binfile/ignore-index-errors? true)
(assoc ::binfile/migrate? true)
(binfile/import!))))
@ -430,14 +437,6 @@
;; --- COMMAND: Get list of builtin templates
(s/def ::retrieve-list-of-builtin-templates any?)
(sv/defmethod ::retrieve-list-of-builtin-templates
{::doc/added "1.10"
::doc/deprecated "1.19"}
[cfg _params]
(mapv #(select-keys % [:id :name]) (::setup/templates cfg)))
(sv/defmethod ::get-builtin-templates
{::doc/added "1.19"}
[cfg _params]

View file

@ -60,7 +60,7 @@
(files/check-edition-permissions! pool profile-id file-id)
(media/validate-media-type! content)
(media/validate-media-size! content)
(let [object (create-file-media-object cfg params)
(let [object (db/run! cfg #(create-file-media-object % params))
props {:name (:name params)
:file-id file-id
:is-local (:is-local params)
@ -142,7 +142,7 @@
(assoc ::image (process-main-image info)))))
(defn create-file-media-object
[{:keys [::sto/storage ::db/pool] :as cfg}
[{:keys [::sto/storage ::db/conn] :as cfg}
{:keys [id file-id is-local name content]}]
(let [result (-> (climit/configure cfg :process-image)
@ -152,7 +152,7 @@
thumb (when-let [params (::thumb result)]
(sto/put-object! storage params))]
(db/exec-one! pool [sql:create-file-media-object
(db/exec-one! conn [sql:create-file-media-object
(or id (uuid/next))
file-id is-local name
(:id image)
@ -176,9 +176,9 @@
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id)
(create-file-media-object-from-url cfg params)))
(db/run! cfg #(create-file-media-object-from-url % params))))
(defn- download-image
(defn download-image
[{:keys [::http/client]} uri]
(letfn [(parse-and-validate [{:keys [headers] :as response}]
(let [size (some-> (get headers "content-length") d/parse-integer)
@ -209,7 +209,6 @@
{:method :get :uri uri}
{:response-type :input-stream :sync? true})
{:keys [size mtype]} (parse-and-validate response)
path (tmp/tempfile :prefix "penpot.media.download.")
written (io/write-to-file! body path :size size)]
@ -223,7 +222,6 @@
:path path
:mtype mtype})))
(defn- create-file-media-object-from-url
[cfg {:keys [url name] :as params}]
(let [content (download-image cfg url)

View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.spec :as us]
@ -79,20 +80,25 @@
(def check-read-permissions!
(perms/make-check-fn has-read-permissions?))
(defn decode-row
[{:keys [features] :as row}]
(when row
(cond-> row
features (assoc :features (db/decode-pgarray features #{})))))
;; --- Query: Teams
(declare retrieve-teams)
(declare get-teams)
(def counter (volatile! 0))
(s/def ::get-teams
(s/keys :req [::rpc/profile-id]))
(def ^:private schema:get-teams
[:map {:title "get-teams"}])
(sv/defmethod ::get-teams
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-teams}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(dm/with-open [conn (db/open pool)]
(retrieve-teams conn profile-id)))
(get-teams conn profile-id)))
(def sql:teams
"select t.*,
@ -119,37 +125,65 @@
(dissoc :is-owner :is-admin :can-edit)
(assoc :permissions permissions))))
(defn retrieve-teams
(defn get-teams
[conn profile-id]
(let [profile (profile/get-profile conn profile-id)]
(->> (db/exec! conn [sql:teams (:default-team-id profile) profile-id])
(mapv process-permissions))))
(map decode-row)
(map process-permissions)
(vec))))
;; --- Query: Team (by ID)
(declare retrieve-team)
(declare get-team)
(s/def ::get-team
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
(def ^:private schema:get-team
[:map {:title "get-team"}
[:id ::sm/uuid]])
(sv/defmethod ::get-team
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
(dm/with-open [conn (db/open pool)]
(retrieve-team conn profile-id id)))
{::doc/added "1.17"
::sm/params schema:get-team}
[cfg {:keys [::rpc/profile-id id]}]
(db/tx-run! cfg #(get-team % :profile-id profile-id :team-id id)))
(defn retrieve-team
[conn profile-id team-id]
(let [profile (profile/get-profile conn profile-id)
sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
result (db/exec-one! conn [sql (:default-team-id profile) profile-id team-id])]
(defn get-team
[conn & {:keys [profile-id team-id project-id file-id] :as params}]
(dm/assert!
"profile-id is mandatory"
(uuid? profile-id))
(let [{:keys [default-team-id] :as profile} (profile/get-profile conn profile-id)
result (cond
(some? team-id)
(let [sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")]
(db/exec-one! conn [sql default-team-id profile-id team-id]))
(some? project-id)
(let [sql (str "WITH teams AS (" sql:teams ") "
"SELECT t.* FROM teams AS t "
" JOIN project AS p ON (p.team_id = t.id) "
" WHERE p.id=?")]
(db/exec-one! conn [sql default-team-id profile-id project-id]))
(some? file-id)
(let [sql (str "WITH teams AS (" sql:teams ") "
"SELECT t.* FROM teams AS t "
" JOIN project AS p ON (p.team_id = t.id) "
" JOIN file AS f ON (f.project_id = p.id) "
" WHERE f.id=?")]
(db/exec-one! conn [sql default-team-id profile-id file-id]))
:else
(throw (IllegalArgumentException. "invalid arguments")))]
(when-not result
(ex/raise :type :not-found
:code :team-does-not-exist))
(process-permissions result)))
(-> result
(decode-row)
(process-permissions))))
;; --- Query: Team Members
@ -165,44 +199,48 @@
join profile as p on (p.id = tp.profile_id)
where tp.team_id = ?")
(defn retrieve-team-members
(defn get-team-members
[conn team-id]
(db/exec! conn [sql:team-members team-id]))
(s/def ::team-id ::us/uuid)
(s/def ::get-team-members
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-team-memebrs
[:map {:title "get-team-members"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-team-members
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-memebrs}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id)))
(get-team-members conn team-id)))
;; --- Query: Team Users
(declare retrieve-users)
(declare retrieve-team-for-file)
(declare get-users)
(declare get-team-for-file)
(s/def ::get-team-users
(s/and (s/keys :req [::rpc/profile-id]
:opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %))))
(def ^:private schema:get-team-users
[:and {:title "get-team-users"}
[:map
[:team-id {:optional true} ::sm/uuid]
[:file-id {:optional true} ::sm/uuid]]
[:fn #(or (contains? % :team-id)
(contains? % :file-id))]])
(sv/defmethod ::get-team-users
{::doc/added "1.17"}
"Get team users by team-id or by file-id"
{::doc/added "1.17"
::sm/params schema:get-team-users}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id]}]
(dm/with-open [conn (db/open pool)]
(if team-id
(do
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id))
(let [{team-id :id} (retrieve-team-for-file conn file-id)]
(get-users conn team-id))
(let [{team-id :id} (get-team-for-file conn file-id)]
(check-read-permissions! conn profile-id team-id)
(retrieve-users conn team-id)))))
(get-users conn team-id)))))
;; This is a similar query to team members but can contain more data
;; because some user can be explicitly added to project or file (not
@ -233,44 +271,44 @@
join file as f on (p.id = f.project_id)
where f.id = ?")
(defn retrieve-users
(defn get-users
[conn team-id]
(db/exec! conn [sql:team-users team-id team-id team-id]))
(defn retrieve-team-for-file
(defn get-team-for-file
[conn file-id]
(->> [sql:team-by-file file-id]
(db/exec-one! conn)))
;; --- Query: Team Stats
(declare retrieve-team-stats)
(declare get-team-stats)
(s/def ::get-team-stats
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-team-stats
[:map {:title "get-team-stats"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-team-stats
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-stats}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id)))
(get-team-stats conn team-id)))
(def sql:team-stats
"select (select count(*) from project where team_id = ?) as projects,
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
(defn retrieve-team-stats
(defn get-team-stats
[conn team-id]
(db/exec-one! conn [sql:team-stats team-id team-id]))
;; --- Query: Team invitations
(s/def ::get-team-invitations
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-team-invitations
[:map {:title "get-team-invitations"}
[:team-id ::sm/uuid]])
(def sql:team-invitations
"select email_to as email, role, (valid_until < now()) as expired
@ -282,7 +320,8 @@
(mapv #(update % :role keyword))))
(sv/defmethod ::get-team-invitations
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-invitations}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
@ -297,40 +336,50 @@
(declare ^:private create-team-role)
(declare ^:private create-team-default-project)
(s/def ::create-team
(s/keys :req [::rpc/profile-id]
:req-un [::name]
:opt-un [::id]))
(def ^:private schema:create-team
[:map {:title "create-team"}
[:name :string]
[:features {:optional true} ::cfeat/features]
[:id {:optional true} ::sm/uuid]])
(sv/defmethod ::create-team
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(quotes/check-quote! conn {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id})
{::doc/added "1.17"
::sm/params schema:create-team}
[cfg {:keys [::rpc/profile-id] :as params}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(quotes/check-quote! conn {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id})
(create-team conn (assoc params :profile-id profile-id))))
(let [features (-> (cfeat/get-enabled-features cf/flags)
(cfeat/check-client-features! (:features params)))]
(create-team cfg (assoc params
:profile-id profile-id
:features features))))))
(defn create-team
"This is a complete team creation process, it creates the team
object and all related objects (default role and default project)."
[conn params]
(let [team (create-team* conn params)
[cfg-or-conn params]
(let [conn (db/get-connection cfg-or-conn)
team (create-team* conn params)
params (assoc params
:team-id (:id team)
:role :owner)
:team-id (:id team)
:role :owner)
project (create-team-default-project conn params)]
(create-team-role conn params)
(assoc team :default-project-id (:id project))))
(defn- create-team*
[conn {:keys [id name is-default] :as params}]
[conn {:keys [id name is-default features] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :team
{:id id
:name name
:is-default is-default})))
is-default (if (boolean? is-default) is-default false)
features (db/create-array conn "text" features)
team (db/insert! conn :team
{:id id
:name name
:features features
:is-default is-default})]
(decode-row team)))
(defn- create-team-role
[conn {:keys [profile-id team-id role] :as params}]
@ -396,7 +445,7 @@
(defn leave-team
[conn {:keys [profile-id id reassign-to]}]
(let [perms (get-permissions conn profile-id id)
members (retrieve-team-members conn id)]
members (get-team-members conn id)]
(cond
;; we can only proceed if there are more members in the team
@ -480,10 +529,15 @@
(s/def ::team-id ::us/uuid)
(s/def ::member-id ::us/uuid)
(s/def ::role #{:owner :admin :editor})
;; Temporarily disabled viewer role
;; https://tree.taiga.io/project/penpot/issue/1083
;; (s/def ::role #{:owner :admin :editor :viewer})
(s/def ::role #{:owner :admin :editor})
(def valid-roles
#{:owner :admin :editor #_:viewer})
(def schema:role
[::sm/one-of valid-roles])
(defn role->params
[role]
@ -500,7 +554,7 @@
;; convenience, if this becomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanisms.
(let [perms (get-permissions conn profile-id team-id)
members (retrieve-team-members conn team-id)
members (get-team-members conn team-id)
member (d/seek #(= member-id (:id %)) members)
is-owner? (:is-owner perms)
@ -596,7 +650,7 @@
(defn update-team-photo
[{:keys [::db/pool ::sto/storage] :as cfg} {:keys [profile-id team-id] :as params}]
(let [team (retrieve-team pool profile-id team-id)
(let [team (get-team pool profile-id team-id)
photo (profile/upload-photo cfg params)]
(db/with-atomic [conn pool]
@ -784,14 +838,24 @@
(s/merge ::create-team
(s/keys :req-un [::emails ::role])))
(def ^:private schema:create-team-with-invitations
[:map {:title "create-team-with-invitations"}
[:name :string]
[:features {:optional true} ::cfeat/features]
[:id {:optional true} ::sm/uuid]
[:emails ::sm/set-of-emails]
[:role schema:role]])
(sv/defmethod ::create-team-with-invitations
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:create-team-with-invitations}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
(db/with-atomic [conn pool]
(let [params (assoc params :profile-id profile-id)
team (create-team conn params)
profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg ::db/conn conn)]
cfg (assoc cfg ::db/conn conn)
team (create-team cfg params)
profile (db/get-by-id conn :profile profile-id)]
;; Create invitations for all provided emails.
(->> emails

View file

@ -8,6 +8,7 @@
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.schema :as sm]
[app.db :as db]
[app.rpc :as-alias rpc]
@ -83,7 +84,7 @@
[:map {:title "get-view-only-bundle"}
[:file-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]
[:features {:optional true} files/schema:features]])
[:features {:optional true} ::cfeat/features]])
(sv/defmethod ::get-view-only-bundle
{::rpc/auth false

View file

@ -12,7 +12,7 @@
[app.auth :refer [derive-password]]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.files.features :as ffeat]
[app.common.features :as cfeat]
[app.common.files.migrations :as pmg]
[app.common.logging :as l]
[app.common.pages :as cp]
@ -100,10 +100,10 @@
(binding [*conn* conn
pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn id)
ffeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
ffeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "storage/objectd-map") omap/wrap identity)]
cfeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objectd-map") omap/wrap identity)]
(let [file (-> file
(update :data blob/decode)
(cond-> migrate? (update :data pmg/migrate-data))
@ -118,7 +118,7 @@
:features features}
{:id id})
(when (contains? (:features file) "storage/pointer-map")
(when (contains? (:features file) "fdata/pointer-map")
(files/persist-pointers! conn id))))
(dissoc file :data))))))
@ -161,10 +161,10 @@
(binding [*conn* conn
pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn (:id file))
ffeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
ffeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "storage/objects-map") omap/wrap identity)]
cfeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objects-map") omap/wrap identity)]
(try
(on-file file)
(catch Throwable cause
@ -209,10 +209,10 @@
(binding [*conn* conn
pmap/*tracked* (atom {})
pmap/*load-fn* (partial files/load-pointer conn (:id file))
ffeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
ffeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "storage/objectd-map") omap/wrap identity)]
cfeat/*wrap-with-pointer-map-fn*
(if (contains? (:features file) "fdata/pointer-map") pmap/wrap identity)
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objectd-map") omap/wrap identity)]
(on-file file))
(catch Throwable cause
((or on-error on-error*) cause file))))

View file

@ -10,16 +10,18 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.logging :as l]
[app.common.pprint :as p]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as features.fdata]
[app.msgbus :as mbus]
[app.rpc.commands.auth :as auth]
[app.rpc.commands.profile :as profile]
[app.rpc.commands.files-snapshot :as fsnap]
[app.rpc.commands.profile :as profile]
[app.srepl.fixes :as f]
[app.srepl.helpers :as h]
[app.storage :as sto]
@ -110,41 +112,57 @@
(defn enable-objects-map-feature-on-file!
[system & {:keys [save? id]}]
(letfn [(update-file [{:keys [features] :as file}]
(if (contains? features "storage/objects-map")
file
(-> file
(update :data migrate)
(update :features conj "storage/objects-map"))))
(migrate [data]
(-> data
(update :pages-index update-vals #(update % :objects omap/wrap))
(update :components update-vals #(update % :objects omap/wrap))))]
(h/update-file! system
:id id
:update-fn update-file
:save? save?)))
(h/update-file! system
:id id
:update-fn features.fdata/enable-objects-map
:save? save?))
(defn enable-pointer-map-feature-on-file!
[system & {:keys [save? id]}]
(letfn [(update-file [{:keys [features] :as file}]
(if (contains? features "storage/pointer-map")
file
(-> file
(update :data migrate)
(update :features conj "storage/pointer-map"))))
(h/update-file! system
:id id
:update-fn features.fdata/enable-pointer-map
:save? save?))
(migrate [data]
(-> data
(update :pages-index update-vals pmap/wrap)
(update :components pmap/wrap)))]
(defn enable-team-feature!
[system team-id feature]
(dm/verify!
"feature should be supported"
(contains? cfeat/supported-features feature))
(h/update-file! system
:id id
:update-fn update-file
:save? save?)))
(let [team-id (if (string? team-id)
(parse-uuid team-id)
team-id)]
(db/tx-run! system
(fn [{:keys [::db/conn]}]
(let [team (-> (db/get conn :team {:id team-id})
(update :features db/decode-pgarray #{}))
features (conj (:features team) feature)]
(when (not= features (:features team))
(db/update! conn :team
{:features (db/create-array conn "text" features)}
{:id team-id})
:enabled))))))
(defn disable-team-feature!
[system team-id feature]
(dm/verify!
"feature should be supported"
(contains? cfeat/supported-features feature))
(let [team-id (if (string? team-id)
(parse-uuid team-id)
team-id)]
(db/tx-run! system
(fn [{:keys [::db/conn]}]
(let [team (-> (db/get conn :team {:id team-id})
(update :features db/decode-pgarray #{}))
features (disj (:features team) feature)]
(when (not= features (:features team))
(db/update! conn :team
{:features (db/create-array conn "text" features)}
{:id team-id})
:disabled))))))
(defn enable-storage-features-on-file!
[system & {:as params}]

View file

@ -29,7 +29,7 @@
(defmethod ig/prep-key ::cleaner
[_ cfg]
(assoc cfg ::min-age (dt/duration "30m")))
(assoc cfg ::min-age (dt/duration "60m")))
(defmethod ig/init-key ::cleaner
[_ cfg]

View file

@ -298,7 +298,7 @@
(clean-file-thumbnails! cfg id revn)
(clean-deleted-components! conn id data)
(when (contains? features "storage/pointer-map")
(when (contains? features "fdata/pointer-map")
(clean-data-fragments! conn id data))
;; Mark file as trimmed

View file

@ -73,7 +73,7 @@
IPointerMap
(load! [_]
(l/trace :hint "pointer-map:load" :id id)
(l/trace :hint "pointer-map:load" :id (str id))
(when-not *load-fn*
(throw (UnsupportedOperationException. "load is not supported when *load-fn* is not bind")))

View file

@ -10,11 +10,12 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.flags :as flags]
[app.common.pages :as cp]
[app.common.pprint :as pp]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -66,8 +67,9 @@
:enable-email-verification
:enable-smtp
:enable-quotes
:enable-fdata-storage-pointer-map
:enable-fdata-storage-objets-map
:enable-feature-fdata-pointer-map
:enable-feature-fdata-objets-map
:enable-feature-components-v2
:disable-file-validation])
(def test-init-sql
@ -206,65 +208,72 @@
;; --- FACTORIES
(defn create-profile*
([i] (create-profile* *pool* i {}))
([i params] (create-profile* *pool* i params))
([pool i params]
([i] (create-profile* *system* i {}))
([i params] (create-profile* *system* i params))
([system i params]
(let [params (merge {:id (mk-uuid "profile" i)
:fullname (str "Profile " i)
:email (str "profile" i ".test@nodomain.com")
:password "123123"
:is-demo false}
params)]
(dm/with-open [conn (db/open pool)]
(->> params
(cmd.auth/create-profile! conn)
(cmd.auth/create-profile-rels! conn))))))
(db/run! system
(fn [{:keys [::db/conn]}]
(->> params
(cmd.auth/create-profile! conn)
(cmd.auth/create-profile-rels! conn)))))))
(defn create-project*
([i params] (create-project* *pool* i params))
([pool i {:keys [profile-id team-id] :as params}]
([i params] (create-project* *system* i params))
([system i {:keys [profile-id team-id] :as params}]
(us/assert uuid? profile-id)
(us/assert uuid? team-id)
(dm/with-open [conn (db/open pool)]
(->> (merge {:id (mk-uuid "project" i)
:name (str "project" i)}
params)
(#'teams/create-project conn)))))
(db/run! system
(fn [{:keys [::db/conn]}]
(->> (merge {:id (mk-uuid "project" i)
:name (str "project" i)}
params)
(#'teams/create-project conn))))))
(defn create-file*
([i params]
(create-file* *pool* i params))
([pool i {:keys [profile-id project-id] :as params}]
(us/assert uuid? profile-id)
(us/assert uuid? project-id)
(db/with-atomic [conn (db/open pool)]
(files.create/create-file conn
(merge {:id (mk-uuid "file" i)
:name (str "file" i)
:components-v2 true}
params)))))
(create-file* *system* i params))
([system i {:keys [profile-id project-id] :as params}]
(dm/assert! "expected uuid" (uuid? profile-id))
(dm/assert! "expected uuid" (uuid? project-id))
(db/run! system
(fn [system]
(let [features (cfeat/get-enabled-features cf/flags)]
(files.create/create-file system
(merge {:id (mk-uuid "file" i)
:name (str "file" i)
:features features}
params)))))))
(defn mark-file-deleted*
([params] (mark-file-deleted* *pool* params))
([params] (mark-file-deleted* *system* params))
([conn {:keys [id] :as params}]
(#'files/mark-file-deleted! conn {:id id})))
(defn create-team*
([i params] (create-team* *pool* i params))
([pool i {:keys [profile-id] :as params}]
([i params] (create-team* *system* i params))
([system i {:keys [profile-id] :as params}]
(us/assert uuid? profile-id)
(dm/with-open [conn (db/open pool)]
(let [id (mk-uuid "team" i)]
(dm/with-open [conn (db/open system)]
(let [id (mk-uuid "team" i)
features (cfeat/get-enabled-features cf/flags)]
(teams/create-team conn {:id id
:profile-id profile-id
:features features
:name (str "team" i)})))))
(defn create-file-media-object*
([params] (create-file-media-object* *pool* params))
([pool {:keys [name width height mtype file-id is-local media-id]
([params] (create-file-media-object* *system* params))
([system {:keys [name width height mtype file-id is-local media-id]
:or {name "sample" width 100 height 100 mtype "image/svg+xml" is-local true}}]
(dm/with-open [conn (db/open pool)]
(dm/with-open [conn (db/open system)]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
@ -276,14 +285,14 @@
:mtype mtype}))))
(defn link-file-to-library*
([params] (link-file-to-library* *pool* params))
([pool {:keys [file-id library-id] :as params}]
(dm/with-open [conn (db/open pool)]
([params] (link-file-to-library* *system* params))
([system {:keys [file-id library-id] :as params}]
(dm/with-open [conn (db/open system)]
(#'files/link-file-to-library conn {:file-id file-id :library-id library-id}))))
(defn create-complaint-for
[pool {:keys [id created-at type]}]
(dm/with-open [conn (db/open pool)]
[system {:keys [id created-at type]}]
(dm/with-open [conn (db/open system)]
(db/insert! conn :profile-complaint-report
{:profile-id id
:created-at (or created-at (dt/now))
@ -291,8 +300,8 @@
:content (db/tjson {})})))
(defn create-global-complaint-for
[pool {:keys [email type created-at]}]
(dm/with-open [conn (db/open pool)]
[system {:keys [email type created-at]}]
(dm/with-open [conn (db/open system)]
(db/insert! conn :global-complaint-report
{:email email
:type (name type)
@ -300,71 +309,72 @@
:content (db/tjson {})})))
(defn create-team-role*
([params] (create-team-role* *pool* params))
([pool {:keys [team-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open pool)]
([params] (create-team-role* *system* params))
([system {:keys [team-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open system)]
(#'teams/create-team-role conn {:team-id team-id
:profile-id profile-id
:role role}))))
(defn create-project-role*
([params] (create-project-role* *pool* params))
([pool {:keys [project-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open pool)]
([params] (create-project-role* *system* params))
([system {:keys [project-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open system)]
(#'teams/create-project-role conn {:project-id project-id
:profile-id profile-id
:role role}))))
(defn create-file-role*
([params] (create-file-role* *pool* params))
([pool {:keys [file-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open pool)]
([params] (create-file-role* *system* params))
([system {:keys [file-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open system)]
(files.create/create-file-role! conn {:file-id file-id
:profile-id profile-id
:role role}))))
(defn update-file*
([params] (update-file* *pool* params))
([pool {:keys [file-id changes session-id profile-id revn]
([params] (update-file* *system* params))
([system {:keys [file-id changes session-id profile-id revn]
:or {session-id (uuid/next) revn 0}}]
(dm/with-open [conn (db/open pool)]
(let [features #{"components/v2"}
cfg (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics])
(assoc ::db/conn conn))]
(files.update/update-file cfg
{:id file-id
:revn revn
:features features
:changes changes
:session-id session-id
:profile-id profile-id})))))
(db/tx-run! system (fn [{:keys [::db/conn] :as system}]
(let [file (files.update/get-file conn file-id)]
(files.update/update-file system
{:id file-id
:revn revn
:file file
:features (:features file)
:changes changes
:session-id session-id
:profile-id profile-id}))))))
(declare command!)
(defn update-file! [& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:components-v2 true
:changes changes}
out (command! params)]
(let [features (cfeat/get-enabled-features cf/flags)
params {::type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:features features
:changes changes}
out (command! params)]
(t/is (nil? (:error out)))
(:result out)))
(defn create-webhook*
([params] (create-webhook* *pool* params))
([pool {:keys [team-id id uri mtype is-active]
:or {is-active true
mtype "application/json"
uri "http://example.com/webhook"}}]
(db/insert! pool :webhook
{:id (or id (uuid/next))
:team-id team-id
:uri uri
:is-active is-active
:mtype mtype})))
([params] (create-webhook* *system* params))
([system {:keys [team-id id uri mtype is-active]
:or {is-active true
mtype "application/json"
uri "http://example.com/webhook"}}]
(db/run! system (fn [{:keys [::db/conn]}]
(db/insert! conn :webhook
{:id (or id (uuid/next))
:team-id team-id
:uri uri
:is-active is-active
:mtype mtype})))))
;; --- RPC HELPERS

View file

@ -6,6 +6,7 @@
(ns backend-tests.rpc-cond-middleware-test
(:require
[app.common.features :as cfeat]
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
@ -27,7 +28,9 @@
:project-id (:id project)})
params {::th/type :get-file
:id (:id file1)
::rpc/profile-id (:id profile)}]
::rpc/profile-id (:id profile)
:features cfeat/supported-features
}]
(binding [cond/*enabled* true]
(let [{:keys [error result]} (th/command! params)]
@ -36,7 +39,7 @@
(t/is (contains? (meta result) :app.http/headers))
(t/is (contains? (meta result) :app.rpc.cond/key))
(let [etag (-> result meta :app.http/headers (get "etag"))
(let [etag (-> result meta :app.http/headers (get "etag"))
{:keys [error result]} (th/command! (assoc params ::cond/key etag))]
(t/is (nil? error))
(t/is (fn? result))

View file

@ -6,9 +6,14 @@
(ns backend-tests.rpc-file-test
(:require
[app.common.features :as cfeat]
[app.common.pprint :as pp]
[app.common.thumbnails :as thc]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.db :as db]
[app.db.sql :as sql]
[app.http :as http]
[app.rpc :as-alias rpc]
[app.storage :as sto]
[app.util.time :as dt]
@ -127,7 +132,7 @@
:id file-id
:session-id (uuid/random)
:revn revn
:components-v2 true
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
@ -248,7 +253,7 @@
:id file-id
:session-id (uuid/random)
:revn revn
:components-v2 true
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
@ -596,10 +601,11 @@
(let [data {::th/type :get-page
::rpc/profile-id (:id prof)
:file-id (:id file)
:components-v2 true}
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (contains? result :objects))
(t/is (contains? (:objects result) frame1-id))
@ -614,7 +620,7 @@
::rpc/profile-id (:id prof)
:file-id (:id file)
:page-id page-id
:components-v2 true}
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (map? result))
@ -631,7 +637,7 @@
:file-id (:id file)
:page-id page-id
:object-id frame1-id
:components-v2 true}
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
@ -648,7 +654,7 @@
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id frame1-id
:components-v2 true}
:features cfeat/supported-features}
out (th/command! data)]
;; (th/print-result! out)
@ -675,9 +681,10 @@
(let [data {::th/type :get-file-data-for-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:components-v2 true}
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (contains? result :page))
(t/is (contains? result :revn))
@ -702,7 +709,7 @@
(let [data {::th/type :get-file-data-for-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:components-v2 true}
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (map? result))

View file

@ -622,9 +622,9 @@
(t/is (uuid? (first result)))
(t/is (= 1 (count result))))))
(t/deftest retrieve-list-of-buitin-templates
(t/deftest get-list-of-buitin-templates
(let [prof (th/create-profile* 1 {:is-active true})
data {::th/type :retrieve-list-of-builtin-templates
data {::th/type :get-builtin-templates
::rpc/profile-id (:id prof)}
out (th/command! data)]
;; (th/print-result! out)