Merge remote-tracking branch 'origin/staging' into develop

This commit is contained in:
Andrey Antukh 2025-02-24 12:49:04 +01:00
commit 1187d64f69
30 changed files with 406 additions and 256 deletions

View file

@ -20,7 +20,6 @@
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.features.components-v2 :as feat.compv2]
[app.features.fdata :as feat.fdata]
[app.features.file-migrations :as feat.fmigr]
[app.loggers.audit :as-alias audit]
@ -307,7 +306,7 @@
update-shapes
(fn [data {:keys [page-id shape-id]}]
(d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-media-refs lookup-index))
(d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-refs lookup-index))
file
(update file :data #(reduce update-shapes % media-refs))]
@ -375,7 +374,7 @@
replace the old :component-file reference with the new
ones, using the provided file-index."
[data]
(cfh/relink-media-refs data lookup-index))
(cfh/relink-refs data lookup-index))
(defn- relink-media
"A function responsible of process the :media attr of file data and
@ -523,38 +522,3 @@
(l/error :hint "file schema validation error" :cause result))))
(insert-file! cfg file opts)))
(defn register-pending-migrations!
"All features that are enabled and requires explicit migration are
added to the state for a posterior migration step."
[cfg {:keys [id features] :as file}]
(doseq [feature (-> (::features cfg)
(set/difference cfeat/no-migration-features)
(set/difference cfeat/backend-only-features)
(set/difference features))]
(vswap! *state* update :pending-to-migrate (fnil conj []) [feature id]))
file)
(defn apply-pending-migrations!
"Apply alredy registered pending migrations to files"
[cfg]
(doseq [[feature file-id] (-> *state* deref :pending-to-migrate)]
(case feature
"components/v2"
(feat.compv2/migrate-file! cfg file-id
:validate? (::validate cfg true)
:skip-on-graphic-error? true)
"fdata/shape-data-type"
nil
;; There is no migration needed, but we don't want to allow
;; copy paste nor import of variant files into no-variant teams
"variants/v1"
nil
(ex/raise :type :internal
:code :no-migration-defined
:hint (str/ffmt "no migation for feature '%' on file importation" feature)
:feature feature))))

View file

@ -0,0 +1,50 @@
;; 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.binfile.migrations
"A binfile related migrations handling"
(:require
[app.binfile.common :as bfc]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.features.components-v2 :as feat.compv2]
[clojure.set :as set]
[cuerdas.core :as str]))
(defn register-pending-migrations!
"All features that are enabled and requires explicit migration are
added to the state for a posterior migration step."
[cfg {:keys [id features] :as file}]
(doseq [feature (-> (::features cfg)
(set/difference cfeat/no-migration-features)
(set/difference cfeat/backend-only-features)
(set/difference features))]
(vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature id]))
file)
(defn apply-pending-migrations!
"Apply alredy registered pending migrations to files"
[cfg]
(doseq [[feature file-id] (-> bfc/*state* deref :pending-to-migrate)]
(case feature
"components/v2"
(feat.compv2/migrate-file! cfg file-id
:validate? (::validate cfg true)
:skip-on-graphic-error? true)
"fdata/shape-data-type"
nil
;; There is no migration needed, but we don't want to allow
;; copy paste nor import of variant files into no-variant teams
"variants/v1"
nil
(ex/raise :type :internal
:code :no-migration-defined
:hint (str/ffmt "no migation for feature '%' on file importation" feature)
:feature feature))))

View file

@ -9,6 +9,7 @@
(:refer-clojure :exclude [assert])
(:require
[app.binfile.common :as bfc]
[app.binfile.migrations :as bfm]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
@ -473,7 +474,7 @@
(read-section options))))
[:v1/metadata :v1/files :v1/rels :v1/sobjects])
(bfc/apply-pending-migrations! cfg)
(bfm/apply-pending-migrations! cfg)
;; Knowing that the ids of the created files are in index,
;; just lookup them and return it as a set

View file

@ -9,6 +9,7 @@
(:refer-clojure :exclude [read])
(:require
[app.binfile.common :as bfc]
[app.binfile.migrations :as bfm]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
@ -735,7 +736,7 @@
(bfc/process-file))]
(bfc/register-pending-migrations! cfg file)
(bfm/register-pending-migrations! cfg file)
(bfc/save-file! cfg file ::db/return-keys false)
file-id')))
@ -915,7 +916,7 @@
(import-file-media cfg)
(import-file-thumbnails cfg)
(bfc/apply-pending-migrations! cfg)
(bfm/apply-pending-migrations! cfg)
ids)))))))

View file

@ -435,7 +435,10 @@
:fn (mg/resource "app/migrations/sql/0137-add-file-migration-table.sql")}
{:name "0138-mod-file-data-fragment-table.sql"
:fn (mg/resource "app/migrations/sql/0138-mod-file-data-fragment-table.sql")}])
:fn (mg/resource "app/migrations/sql/0138-mod-file-data-fragment-table.sql")}
{:name "0139-mod-file-change-table.sql"
:fn (mg/resource "app/migrations/sql/0139-mod-file-change-table.sql")}])
(defn apply-migrations!
[pool name migrations]

View file

@ -0,0 +1,5 @@
ALTER TABLE file_change
DROP CONSTRAINT file_change_file_id_fkey,
DROP CONSTRAINT file_change_profile_id_fkey,
ADD FOREIGN KEY (file_id) REFERENCES file(id) DEFERRABLE,
ADD FOREIGN KEY (profile_id) REFERENCES profile(id) ON DELETE SET NULL DEFERRABLE;

View file

@ -6,6 +6,7 @@
(ns app.rpc.commands.files-snapshot
(:require
[app.binfile.common :as bfc]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.schema :as sm]
@ -22,7 +23,6 @@
[app.rpc.quotes :as quotes]
[app.storage :as sto]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[cuerdas.core :as str]))
@ -58,26 +58,6 @@
(files/check-read-permissions! conn profile-id file-id)
(get-file-snapshots conn file-id))))
(def ^:private sql:get-file
"SELECT f.*,
p.id AS project_id,
p.team_id AS team_id
FROM file AS f
INNER JOIN project AS p ON (p.id = f.project_id)
WHERE f.id = ?")
(defn- get-file
[cfg file-id]
(let [file (->> (db/exec-one! cfg [sql:get-file file-id])
(feat.fdata/resolve-file-data cfg))]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(-> file
(update :data blob/decode)
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(update :data assoc ::id file-id)
(update :data blob/encode)))))
(defn- generate-snapshot-label
[]
(let [ts (-> (dt/now)
@ -87,49 +67,53 @@
(str "snapshot-" ts)))
(defn create-file-snapshot!
[cfg profile-id file-id label]
(let [file (get-file cfg file-id)
[cfg file & {:keys [label created-by deleted-at profile-id]
:or {deleted-at :default
created-by :system}}]
(assert (#{:system :user :admin} created-by)
"expected valid keyword for created-by")
(let [conn
(db/get-connection cfg)
;; NOTE: final user never can provide label as `:system`
;; keyword because the validator implies label always as
;; string; keyword is used for signal a special case
created-by
(if (= label :system)
"system"
"user")
(name created-by)
deleted-at
(if (= label :system)
(cond
(= deleted-at :default)
(dt/plus (dt/now) (cf/get-deletion-delay))
(dt/instant? deleted-at)
deleted-at
:else
nil)
label
(if (= label :system)
(str "internal/snapshot/" (:revn file))
(or label (generate-snapshot-label)))
(or label (generate-snapshot-label))
snapshot-id
(uuid/next)]
(uuid/next)
(-> cfg
(assoc ::quotes/profile-id profile-id)
(assoc ::quotes/project-id (:project-id file))
(assoc ::quotes/team-id (:team-id file))
(assoc ::quotes/file-id (:id file))
(quotes/check! {::quotes/id ::quotes/snapshots-per-file}
{::quotes/id ::quotes/snapshots-per-team}))
data
(blob/encode (:data file))
features
(db/encode-pgarray (:features file) conn "text")]
(l/debug :hint "creating file snapshot"
:file-id (str file-id)
:file-id (str (:id file))
:id (str snapshot-id)
:label label)
(db/insert! cfg :file-change
{:id snapshot-id
:revn (:revn file)
:data (:data file)
:data data
:version (:version file)
:features (:features file)
:features features
:profile-id profile-id
:file-id (:id file)
:label label
@ -146,12 +130,25 @@
(sv/defmethod ::create-file-snapshot
{::doc/added "1.20"
::sm/params schema:create-file-snapshot}
[cfg {:keys [::rpc/profile-id file-id label]}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id)
(create-file-snapshot! cfg profile-id file-id label))))
::sm/params schema:create-file-snapshot
::db/transaction true}
[{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id file-id label]}]
(files/check-edition-permissions! conn profile-id file-id)
(let [file (bfc/get-file cfg file-id)
project (db/get-by-id cfg :project (:project-id file))]
(-> cfg
(assoc ::quotes/profile-id profile-id)
(assoc ::quotes/project-id (:project-id file))
(assoc ::quotes/team-id (:team-id project))
(assoc ::quotes/file-id (:id file))
(quotes/check! {::quotes/id ::quotes/snapshots-per-file}
{::quotes/id ::quotes/snapshots-per-team}))
(create-file-snapshot! cfg file
{:label label
:profile-id profile-id
:created-by :user})))
(defn restore-file-snapshot!
[{:keys [::db/conn ::mbus/msgbus] :as cfg} file-id snapshot-id]
@ -237,8 +234,11 @@
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id)
(create-file-snapshot! cfg profile-id file-id :system)
(restore-file-snapshot! cfg file-id id))))
(let [file (bfc/get-file cfg file-id)]
(create-file-snapshot! cfg file
{:profile-id profile-id
:created-by :system})
(restore-file-snapshot! cfg file-id id)))))
(def ^:private schema:update-file-snapshot
[:map {:title "update-file-snapshot"}

View file

@ -34,7 +34,6 @@
;; --- Mutation: Create Team Invitation
(def sql:upsert-team-invitation
"insert into team_invitation(id, team_id, email_to, created_by, role, valid_until)
values (?, ?, ?, ?, ?, ?)
@ -79,27 +78,23 @@
[:role ::types.team/role]
[:email ::sm/email]])
(def ^:private check-create-invitation-params!
(def ^:private check-create-invitation-params
(sm/check-fn schema:create-invitation))
(defn- allow-invitation-emails?
[member]
(let [notifications (dm/get-in member [:props :notifications])]
(not= :none (:email-invites notifications))))
(defn- create-invitation
[{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
(dm/assert!
"expected valid connection on cfg parameter"
(db/connection? conn))
(dm/assert!
"expected valid params for `create-invitation` fn"
(check-create-invitation-params! params))
(assert (db/connection? conn) "expected valid connection on cfg parameter")
(assert (check-create-invitation-params params))
(let [email (profile/clean-email email)
member (profile/get-profile-by-email conn email)]
(teams/check-profile-muted conn member)
(teams/check-email-bounce conn email true)
(teams/check-email-spam conn email true)
;; When we have email verification disabled and invitation user is
;; already present in the database, we proceed to add it to the
;; team as-is, without email roundtrip.
@ -125,48 +120,54 @@
nil)
(let [id (uuid/next)
expire (dt/in-future "168h") ;; 7 days
invitation (db/exec-one! conn [sql:upsert-team-invitation id
(:id team) (str/lower email)
(:id profile)
(name role) expire
(name role) expire])
updated? (not= id (:id invitation))
profile-id (:id profile)
tprops {:profile-id profile-id
:invitation-id (:id invitation)
:valid-until expire
:team-id (:id team)
:member-email (:email-to invitation)
:member-id (:id member)
:role role}
itoken (create-invitation-token cfg tprops)
ptoken (create-profile-identity-token cfg profile-id)]
(do
(some->> member (teams/check-profile-muted conn))
(teams/check-email-bounce conn email true)
(teams/check-email-spam conn email true)
(when (contains? cf/flags :log-invitation-tokens)
(l/info :hint "invitation token" :token itoken))
(let [id (uuid/next)
expire (dt/in-future "168h") ;; 7 days
invitation (db/exec-one! conn [sql:upsert-team-invitation id
(:id team) (str/lower email)
(:id profile)
(name role) expire
(name role) expire])
updated? (not= id (:id invitation))
profile-id (:id profile)
tprops {:profile-id profile-id
:invitation-id (:id invitation)
:valid-until expire
:team-id (:id team)
:member-email (:email-to invitation)
:member-id (:id member)
:role role}
itoken (create-invitation-token cfg tprops)
ptoken (create-profile-identity-token cfg profile-id)]
(let [props (-> (dissoc tprops :profile-id)
(audit/clean-props))
evname (if updated?
"update-team-invitation"
"create-team-invitation")
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name evname)
(assoc ::audit/props props))]
(audit/submit! cfg event))
(when (contains? cf/flags :log-invitation-tokens)
(l/info :hint "invitation token" :token itoken))
(eml/send! {::eml/conn conn
::eml/factory eml/invite-to-team
:public-uri (cf/get :public-uri)
:to email
:invited-by (:fullname profile)
:team (:name team)
:token itoken
:extra-data ptoken})
(let [props (-> (dissoc tprops :profile-id)
(audit/clean-props))
evname (if updated?
"update-team-invitation"
"create-team-invitation")
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name evname)
(assoc ::audit/props props))]
(audit/submit! cfg event))
itoken))))
(when (allow-invitation-emails? member)
(eml/send! {::eml/conn conn
::eml/factory eml/invite-to-team
:public-uri (cf/get :public-uri)
:to email
:invited-by (:fullname profile)
:team (:name team)
:token itoken
:extra-data ptoken}))
itoken)))))
(defn- add-member-to-team
[conn profile team role member]

View file

@ -16,7 +16,8 @@
[app.rpc.commands.teams :as teams]
[app.rpc.cond :as-alias cond]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]))
[app.util.services :as sv]
[cuerdas.core :as str]))
;; --- QUERY: View Only Bundle
@ -26,6 +27,27 @@
(update :pages (fn [pages] (filterv #(contains? allowed %) pages)))
(update :pages-index select-keys allowed)))
(defn obfuscate-email
[email]
(let [[name domain]
(str/split email "@" 2)
[_ rest]
(str/split domain "." 2)
name
(if (> (count name) 3)
(str (subs name 0 1) (apply str (take (dec (count name)) (repeat "*"))))
"****")]
(str name "@****." rest)))
(defn anonymize-member
[member]
(-> (select-keys member [:id :email :name :fullname :photo-id])
(update :email obfuscate-email)
(assoc :can-read true)))
(defn- get-view-only-bundle
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id ::perms] :as params}]
(let [file (files/get-file cfg file-id)
@ -37,7 +59,10 @@
team (-> (db/get conn :team {:id (:team-id project)})
(teams/decode-row))
members (teams/get-team-members conn (:team-id project))
members (cond->> (teams/get-team-members conn (:team-id project))
(= :share-link (:type perms))
(mapv anonymize-member))
member-ids (into #{} (map :id) members)
perms (assoc perms :in-team (contains? member-ids profile-id))

View file

@ -15,7 +15,8 @@
[app.features.components-v2 :as feat.comp-v2]
[app.main :as main]
[app.rpc.commands.files :as files]
[app.rpc.commands.files-snapshot :as fsnap]))
[app.rpc.commands.files-snapshot :as fsnap]
[app.util.time :as dt]))
(def ^:dynamic *system* nil)
@ -96,8 +97,11 @@
(let [conn (db/get-connection system)]
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(reduce (fn [result file-id]
(fsnap/create-file-snapshot! system nil file-id label)
(inc result))
(let [file (fsnap/get-file-snapshots system file-id)]
(fsnap/create-file-snapshot! system file
{:label label
:created-by :admin})
(inc result)))
0))))
(defn restore-team-snapshot!
@ -143,7 +147,10 @@
(cfv/validate-file-schema! file'))
(when (string? label)
(fsnap/create-file-snapshot! system nil file-id label))
(fsnap/create-file-snapshot! system file
{:label label
:deleted-at (dt/in-future {:days 30})
:created-by :admin}))
(let [file' (update file' :revn inc)]
(bfc/update-file! system file')

View file

@ -40,6 +40,11 @@
:file-id id
:cause cause))))
;; Mark file change to be deleted
(db/update! conn :file-change
{:deleted-at deleted-at}
{:file-id id})
;; Mark file media objects to be deleted
(db/update! conn :file-media-object
{:deleted-at deleted-at}

View file

@ -26,7 +26,7 @@
(defn- delete-profiles!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-profiles min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-profiles min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id]}]
(l/trc :hint "permanently delete" :rel "profile" :id (str id))
@ -49,7 +49,7 @@
(defn- delete-teams!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-teams min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-teams min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "team"
@ -77,7 +77,7 @@
(defn- delete-fonts!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-fonts min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-fonts min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
(l/trc :hint "permanently delete"
:rel "team-font-variant"
@ -109,7 +109,7 @@
(defn- delete-projects!
[{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
(->> (db/cursor conn [sql:get-projects min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-projects min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "project"
@ -135,7 +135,7 @@
(defn- delete-files!
[{:keys [::db/conn ::sto/storage ::min-age ::chunk-size] :as cfg}]
(->> (db/cursor conn [sql:get-files min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-files min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id deleted-at project-id] :as file}]
(l/trc :hint "permanently delete"
:rel "file"
@ -164,7 +164,7 @@
(defn delete-file-thumbnails!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-thumbnails min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-file-thumbnails min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-thumbnail"
@ -193,7 +193,7 @@
(defn delete-file-object-thumbnails!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-object-thumbnails min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-file-object-thumbnails min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-tagged-object-thumbnail"
@ -222,7 +222,7 @@
(defn- delete-file-data-fragments!
[{:keys [::db/conn ::sto/storage ::min-age ::chunk-size] :as cfg}]
(->> (db/cursor conn [sql:get-file-data-fragments min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-file-data-fragments min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id id deleted-at data-ref-id]}]
(l/trc :hint "permanently delete"
:rel "file-data-fragment"
@ -248,7 +248,7 @@
(defn- delete-file-media-objects!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-media-objects min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-file-media-objects min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
(l/trc :hint "permanently delete"
:rel "file-media-object"
@ -275,9 +275,9 @@
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-change!
(defn- delete-file-changes!
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-change min-age chunk-size] {:chunk-size 5})
(->> (db/plan conn [sql:get-file-change min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id file-id deleted-at] :as xlog}]
(l/trc :hint "permanently delete"
:rel "file-change"
@ -299,11 +299,11 @@
#'delete-file-data-fragments!
#'delete-file-object-thumbnails!
#'delete-file-thumbnails!
#'delete-file-changes!
#'delete-files!
#'delete-projects!
#'delete-fonts!
#'delete-teams!
#'delete-file-change!])
#'delete-teams!])
(defn- execute-proc!
"A generic function that executes the specified proc iterativelly
@ -326,7 +326,7 @@
[k v]
{k (assoc v
::min-age (cf/get-deletion-delay)
::chunk-size 50)})
::chunk-size 100)})
(defmethod ig/init-key ::handler
[_ cfg]