github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-03 01:06:14 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/backend/test/backend_tests/binfile_test.clj
Andrey Antukh 7d4feac46b 🐛 Fix svg-attrs test passing MapEntry to SQL query 
The import-svg-attrs-asset helper called (first result) on the
map returned by import-files!, yielding a clojure.lang.MapEntry
instead of a file UUID. PostgreSQL rejected the MapEntry as a
query parameter with "Can't infer the SQL type".

Extract the id via (first (:file-ids result)) as the neighboring
test already does.

AI-assisted-by: longcat-2.5-preview-free
2026-09-30 12:50:28 +00:00

2480 lines
107 KiB
Clojure
Raw Blame History

;; 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 SUBSIDIARY SL
(ns backend-tests.binfile-test
"Internal binfile test, no RPC involved"
(:require
[app.binfile.common :as bfc]
[app.binfile.v1 :as v1]
[app.binfile.v3 :as v3]
[app.common.data :as d]
[app.common.features :as cfeat]
[app.common.files.validate :as cfv]
[app.common.pprint :as pp]
[app.common.thumbnails :as thc]
[app.common.time :as ct]
[app.common.types.shape :as cts]
[app.common.types.tokens-lib :as ctob]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.http :as http]
[app.rpc :as-alias rpc]
[app.rpc.commands.binfile :as binfile]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[backend-tests.helpers :as th]
[backend-tests.storage-test :as stt]
[clojure.java.io :as jio]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[datoteka.io :as io])
(:import
java.io.ByteArrayInputStream
java.io.DataInputStream
java.io.OutputStreamWriter
java.io.Writer
java.util.zip.Deflater
java.util.zip.ZipEntry
java.util.zip.ZipFile
java.util.zip.ZipOutputStream))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(defn- update-file!
[& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:vern 0
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))
(defn- prepare-simple-file
([profile] (prepare-simple-file profile 1))
([profile idx]
(let [page-id-1 (uuid/custom 1 1)
page-id-2 (uuid/custom 1 2)
shape-id (uuid/custom 2 1)
file (th/create-file* idx {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-page
:name "test 1"
:id page-id-1}
{:type :add-page
:name "test 2"
:id page-id-2}])
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id-1
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}])
(dissoc file :data))))
(def ^:private svg-raw-page-id (uuid/custom 1 1))
(def ^:private svg-raw-root-id (uuid/custom 3 1))
(def ^:private svg-raw-child-id (uuid/custom 3 2))
(defn- prepare-svg-raw-file
"A file containing an svg-raw subtree (an svg-raw parent with an
svg-raw child), which is what importing an SVG produces."
([profile] (prepare-svg-raw-file profile 1))
([profile idx]
(let [page-id svg-raw-page-id
root-id svg-raw-root-id
child-id svg-raw-child-id
file (th/create-file* idx {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-page
:name "page 1"
:id page-id}])
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id root-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id root-id
:name "svg-root"
:frame-id uuid/zero
:parent-id uuid/zero
:type :svg-raw
:content {:tag :svg :attrs {} :content []}})}
{:type :add-obj
:page-id page-id
:id child-id
:parent-id root-id
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id child-id
:name "svg-text"
:frame-id uuid/zero
:parent-id root-id
:type :svg-raw
:content {:tag :text :attrs {} :content []}})}])
(dissoc file :data))))
(t/deftest import-binfile-v3-preserves-svg-raw-children
(let [profile (th/create-profile* 1)
file (prepare-svg-raw-file profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(v3/import-files!))
file-id (first (:file-ids result))
imported (:result (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id file-id
:components-v2 true}))
root (get-in imported [:data :pages-index svg-raw-page-id
:objects svg-raw-root-id])]
(t/is (= 1 (count (:file-ids result))))
;; The child ids of an svg-raw shape must survive the JSON round
;; trip as uuids; when they came back as plain strings they no
;; longer resolved against the objects map.
(t/is (every? uuid? (:shapes root)))
(t/is (= [svg-raw-child-id] (vec (:shapes root))))
;; ...so the imported file passes referential integrity instead
;; of failing with :child-not-found on the next update-file.
(t/is (nil? (cfv/validate-file imported []))))))
(defn- import-svg-attrs-asset
"Imports the `svg-attrs-camel-case.penpot` asset, a real penpot export
whose shapes carry `:svg-attrs` keys in camelCase (the format the
binary export writes), and returns the imported file."
[profile]
(let [input (-> "backend_tests/test_files/svg-attrs-camel-case.penpot"
io/resource
jio/file)
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input input)
(v3/import-files!))]
(bfc/get-file th/*system* (first (:file-ids result)))))
(t/deftest import-binfile-v3-preserves-camel-case-svg-attrs
;; The json reader used by the v3 import rewrites every key of every
;; zip entry to kebab-case, and `:svg-attrs` is the one shape map
;; whose keys are camelCase react prop names. A shape exported with
;; `fillRule: "evenodd"` must not come back as `:fill-rule`, or the
;; renderer falls back to the default fill rule and the shape is
;; painted without its hole.
(let [profile (th/create-profile* 1)
file (import-svg-attrs-asset profile)
shape (get-in file [:data :pages-index
(uuid/uuid "fc80ab5f-1bf2-817c-8008-b5408f039100")
:objects
(uuid/uuid "ce3641bd-48c8-804c-8008-b54d35cc6f80")])]
(t/is (= {:fillRule "evenodd"}
(:svg-attrs shape)))))
(t/deftest import-binfile-v3-preserves-camel-case-svg-attrs-on-components
;; Same guarantee for shapes stored inside a component: the v3 import
;; cleans those in a different code path than page shapes.
(let [profile (th/create-profile* 1)
file (import-svg-attrs-asset profile)
shape (fn [component-id shape-id]
(-> file
(get-in [:data :components (uuid/uuid component-id) :objects])
(get (uuid/uuid shape-id))
:svg-attrs))]
(t/is (= {:fillRule "evenodd"}
(shape "fae4bc76-0cc2-8057-8008-b540912cdf78"
"fae4bc76-0cc2-8057-8008-b540912774cb")))
(t/is (= {:fillRule "nonzero"}
(shape "fae4bc76-0cc2-8057-8008-b540912c917b"
"fae4bc76-0cc2-8057-8008-b540912774c8")))))
(t/deftest export-binfile-v3
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
(t/is (map? result))
(t/is (= 1 (count (:file-ids result))))
(t/is (every? uuid? (:file-ids result)))
;; No external libraries in simple case - resolution should be empty
(t/is (= {} (:resolution result))))))
(t/deftest export-binfile-preserves-public-uri-subpath
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
config (assoc cf/config :public-uri "https://example.com/penpot")
params {:file-id (:id file)
::bfc/export-type :detach-libraries}
uri (binding [cf/config config]
(#'binfile/export-binfile th/*system* params))]
(t/is (str/starts-with? (str uri)
"https://example.com/penpot/assets/by-id/"))))
(t/deftest import-binfile-v3-persists-manifest-metadata
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(v3/import-files!))
imported (bfc/get-file th/*system* (first (:file-ids result)))]
(t/is (= 1 (count (:file-ids result))))
(t/is (some? (get-in imported [:metadata :generated-by])))
(t/is (= "penpot" (get-in imported [:metadata :referer]))))))
(t/deftest read-obj-rejects-oversized-buffer
;; N1-07: read-obj! must reject objects exceeding default-max-binary-entry-size
;; before attempting to allocate the buffer
(let [size (+ bfc/default-max-binary-entry-size 1)
baos (java.io.ByteArrayOutputStream. 17)
dos (java.io.DataOutputStream. baos)]
(.writeByte dos 5)
(.writeLong dos (long size))
(.flush dos)
(let [input (java.io.DataInputStream.
(ByteArrayInputStream. (.toByteArray baos)))]
(binding [v1/*position* (atom 0)]
(let [out (try
(v1/read-obj! input)
nil
(catch clojure.lang.ExceptionInfo e
(ex-data e)))]
;; Without the guard, read-obj! will either OOM or proceed
;; to read-bytes! on a truncated stream (no :max-file-size-reached).
;; With the guard, it raises :validation :max-file-size-reached.
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))))
(t/deftest slugify-name-test
(t/is (= "my-design-system" (bfc/slugify-name "My Design System!")))
(t/is (= "icons" (bfc/slugify-name "Icons")))
(t/is (= "brand-colors-2024" (bfc/slugify-name "Brand Colors 2024")))
(t/is (= "" (bfc/slugify-name "---"))))
(t/deftest export-includes-external-libraries
(let [profile (th/create-profile* 1)
;; Create a shared library file
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
;; Create a file that uses the library
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Link file to library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file)
:library-file-id (:id library)})
;; Export without including libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Read the manifest and check external-libraries
(let [manifest (v3/get-manifest th/*system* output)]
(t/is (some? (:external-libraries manifest)))
(t/is (= 1 (count (:external-libraries manifest))))
(let [ext-lib (first (:external-libraries manifest))]
(t/is (= (:id library) (:id ext-lib)))
(t/is (= "Icons Library" (:name ext-lib)))
(t/is (= "icons-library" (:slug ext-lib)))
(t/is (= [(:id file)] (:used-by ext-lib))))))))
(t/deftest import-auto-links-single-candidate
(let [profile (th/create-profile* 1)
;; Create a shared library file
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
;; Create a file that uses the library
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Link file to library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file)
:library-file-id (:id library)})
;; Export without including libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Remove the source library to simulate a cross-environment import
;; where the original library does not exist in the target team.
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library)})
;; Now create a new shared library with the same name in the same team
;; (simulating the library existing in the target environment)
(let [library2 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
;; Check that the library was auto-linked in the resolution
(let [resolution (:resolution result)
file-id (first (:file-ids result))
file-res (get resolution file-id)]
;; File should have name
(t/is (some? (:name file-res)))
;; File should have one auto-linked library in :done
(t/is (= 1 (count (:done file-res))))
(let [done-entry (first (:done file-res))]
(t/is (= (:id library) (:id done-entry)))
(t/is (= (:id library2) (:linked-to done-entry))))
;; No pending candidates
(t/is (= [] (:pending file-res))))
;; Verify the file-library-rel was created
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 1 (count rels))))))))
(t/deftest import-no-auto-link-no-match
(let [profile (th/create-profile* 1)
;; Create a shared library file
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
;; Create a file that uses the library
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Link file to library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file)
:library-file-id (:id library)})
;; Export without including libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
;; Remove the source library to simulate a cross-environment import
;; where no matching library exists in the target team.
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library)})
;; Import without any matching library in the team
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
;; No auto-linking should happen - resolution should be empty
(t/is (= {} (:resolution result)))))))
(t/deftest import-returns-multi-match-candidates
(let [profile (th/create-profile* 1)
;; Create a shared library file
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
;; Create a file that uses the library
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Link file to library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file)
:library-file-id (:id library)})
;; Export without including libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Remove the source library to simulate a cross-environment import
;; where the original library does not exist in the target team.
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library)})
;; Create TWO shared libraries with the same name
(let [library2 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
library3 (th/create-file* 4 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
;; No auto-linking (multi-match) - check resolution structure
(let [resolution (:resolution result)
file-id (first (:file-ids result))
file-res (get resolution file-id)]
;; File should have name
(t/is (some? (:name file-res)))
;; No auto-linked libraries
(t/is (= [] (:done file-res)))
;; Should have pending candidates
(t/is (= 1 (count (:pending file-res))))
(let [pending-entry (first (:pending file-res))]
(t/is (= (:id library) (:id pending-entry)))
(t/is (= 2 (count (:candidates pending-entry))))
;; Each candidate should have project info
(doseq [candidate (:candidates pending-entry)]
(t/is (some? (:project-id candidate)))
(t/is (some? (:project-name candidate))))))
;; No file-library-rel should be created automatically
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 0 (count rels))))
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library3)})]
(t/is (= 0 (count rels))))))))
(t/deftest import-auto-link-respects-library-permissions
(let [owner (th/create-profile* 1)
team (th/create-team* 1 {:profile-id (:id owner)})
viewer (th/create-profile* 2)
_ (th/create-team-role* {:team-id (:id team)
:profile-id (:id viewer)
:role :viewer})
library (th/create-file* 1 {:profile-id (:id owner)
:project-id (:default-project-id owner)
:is-shared true
:name "Icons Library"})
file (th/create-file* 2 {:profile-id (:id owner)
:project-id (:default-project-id owner)
:is-shared false})]
;; Link file to library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file)
:library-file-id (:id library)})
;; Export with link-later to compute external-libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Remove the source library and recreate a matching one owned by owner
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library)})
;; Create a project in the team for the matched library and import.
(let [project (th/create-project* 1 {:profile-id (:id owner)
:team-id (:id team)})
library2 (th/create-file* 3 {:profile-id (:id owner)
:project-id (:id project)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:id project))
(assoc ::bfc/profile-id (:id viewer))
(assoc ::bfc/team-id (:id team))
(assoc ::bfc/input output)
(v3/import-files!))]
;; Auto-link must be skipped because viewer cannot edit the library
(let [resolution (:resolution result)
file-id (first (:file-ids result))
file-res (get resolution file-id)]
;; No auto-linked libraries - file may not be in resolution map at all
(t/is (or (nil? file-res)
(= [] (:done file-res)))))
;; No file-library-rel should have been created
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 0 (count rels))))
;; Control: the same import performed by the owner (who has edit
;; permission on the library) should auto-link.
(let [result (-> th/*system*
(assoc ::bfc/project-id (:id project))
(assoc ::bfc/profile-id (:id owner))
(assoc ::bfc/team-id (:id team))
(assoc ::bfc/input output)
(v3/import-files!))]
(let [resolution (:resolution result)
file-id (first (:file-ids result))
file-res (get resolution file-id)]
;; Should have name
(t/is (some? (:name file-res)))
;; Should have one auto-linked library
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id library2) (:linked-to (first (:done file-res))))))
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 1 (count rels)))))))))
(t/deftest import-auto-link-only-files-that-used-library
(let [profile (th/create-profile* 1)
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
file1 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file2 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Only file1 uses the library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file1)
:library-file-id (:id library)})
;; Export both files without including libraries
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file1) (:id file2)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Remove the source library and recreate a matching one
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library)})
(let [library2 (th/create-file* 4 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
;; The library should be auto-linked for the file that used it
(let [resolution (:resolution result)
;; Find the file that has auto-linked libraries
file-with-done (d/seek #(seq (:done %)) (vals resolution))]
(t/is (some? file-with-done))
;; Should have name
(t/is (some? (:name file-with-done)))
(t/is (= 1 (count (:done file-with-done))))
(t/is (= (:id library2) (:linked-to (first (:done file-with-done)))))
;; But only one file-library-rel should exist (for file1)
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 1 (count rels)))))))))
;; =============================================================================
;; COMPREHENSIVE LINK-LATER TESTS
;; =============================================================================
(defn- import-sample-file
"Import the file-with-library.penpot sample file and return
{:profile :file :library :team}. The sample contains a library and
a file that uses it."
([]
(import-sample-file th/*system*))
([system]
(let [profile (th/create-profile* system 1 {})
input (th/tempfile "backend_tests/test_files/file-with-library.penpot")
result (-> system
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input input)
(v3/import-files!))
file-ids (:file-ids result)
;; Find the file-library-rel to identify which id is the file
;; and which is the library. Relation: file-id -> library-file-id.
rels (keep #(when-let [r (db/query system :file-library-rel
{:file-id %})]
(first r))
file-ids)
rel (first rels)
file-id (:file-id rel)
library-id (:library-file-id rel)]
{:profile profile
:file-id file-id
:library-id library-id
:all-file-ids (set file-ids)
:team-id (:default-team-id profile)})))
(defn- create-named-library
"Create a shared library with the given name in the given team."
([team-id name]
(create-named-library th/*system* 1 team-id name))
([system i team-id name]
(let [profile (th/create-profile* system i {})
project (th/create-project* system i {:profile-id (:id profile)
:team-id team-id})]
(th/create-file* system i {:profile-id (:id profile)
:project-id (:id project)
:is-shared true
:name name}))))
(defn- get-file-shapes
"Get all shapes from a file's data."
[file-data]
(let [pages (vals (:pages-index file-data))]
(mapcat vals (map :objects pages))))
;; -----------------------------------------------------------------------------
;; Category 1: Same-Team Round-Trip
;; -----------------------------------------------------------------------------
(t/deftest link-later-same-team-round-trip
(let [{:keys [profile file-id team-id]} (import-sample-file)
_ (t/is (some? file-id))
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Verify manifest has external-libraries
(let [manifest (v3/get-manifest th/*system* output)
ext-libs (:external-libraries manifest)]
(t/is (some? ext-libs))
(t/is (pos? (count ext-libs))))
;; Re-import in same team
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Should have auto-linked library
(t/is (some? file-res))
(t/is (some? (:name file-res)))
(t/is (= 1 (count (:done file-res))))
(t/is (= [] (:pending file-res)))
;; Verify file-library-rel was created
(let [rels (db/query th/*system* :file-library-rel {:file-id new-file-id})]
(t/is (pos? (count rels)))))))
(t/deftest link-later-same-team-idempotent
(let [{:keys [profile file-id team-id]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; First import
(let [result1 (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))]
(t/is (= 1 (count (:file-ids result1)))))
;; Second import (should succeed)
(let [result2 (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))]
(t/is (= 1 (count (:file-ids result2))))
(let [resolution (:resolution result2)
new-file-id (first (:file-ids result2))
file-res (get resolution new-file-id)]
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))))))
(t/deftest link-later-overwrite-import-no-resolution
(let [{:keys [profile file-id team-id]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import with overwrite (file-id set)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/file-id file-id)
(assoc ::bfc/input output)
(v3/import-files!))]
;; Overwrite should have empty resolution
(t/is (= {} (:resolution result))))))
;; -----------------------------------------------------------------------------
;; Category 2: Cross-Team Migration
;; -----------------------------------------------------------------------------
(t/deftest link-later-cross-team-library-pre-exists
(let [{:keys [profile file-id team-id]} (import-sample-file)
;; Create a second team with a library named "LIbrary"
team2 (th/create-team* 2 {:profile-id (:id profile)})
library2 (create-named-library th/*system* 10 (:id team2) "LIbrary")
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later from team 1
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import in team 2 (where library with same name exists)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Should auto-link to library2
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id library2) (:linked-to (first (:done file-res)))))
;; Verify file-library-rel was created
(let [rels (db/query th/*system* :file-library-rel
{:library-file-id (:id library2)})]
(t/is (= 1 (count rels)))))))
(t/deftest link-later-cross-team-no-library
(let [{:keys [profile file-id]} (import-sample-file)
team2 (th/create-team* 2 {:profile-id (:id profile)})
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import in team 2 (no library exists)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; No linking should happen
(t/is (= {} resolution)))))
(t/deftest link-later-cross-team-different-library-name
(let [{:keys [profile file-id]} (import-sample-file)
team2 (th/create-team* 2 {:profile-id (:id profile)})
library2 (create-named-library th/*system* 10 (:id team2) "Buttons Library")
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import in team 2 (library with different name)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; No linking (slug mismatch)
(t/is (= {} resolution)))))
(t/deftest link-later-cross-team-library-not-shared
(let [{:keys [profile file-id]} (import-sample-file)
team2 (th/create-team* 2 {:profile-id (:id profile)})
;; Create a private (non-shared) library
_ (let [priv-project (th/create-project* th/*system* 20 {:profile-id (:id profile)
:team-id (:id team2)})
priv-lib (th/create-file* th/*system* 21 {:profile-id (:id profile)
:project-id (:id priv-project)
:is-shared false
:name "LIbrary"})])
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import in team 2 (library exists but not shared)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; No linking (library not shared)
(t/is (= {} resolution)))))
(t/deftest link-later-cross-team-library-deleted
(let [{:keys [profile file-id]} (import-sample-file)
team2 (th/create-team* 2 {:profile-id (:id profile)})
library2 (create-named-library th/*system* 10 (:id team2) "LIbrary")
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete the library in team 2
(db/update! th/*system* :file
{:deleted-at (ct/now)}
{:id (:id library2)})
;; Import in team 2 (library deleted)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; No linking (library deleted)
(t/is (= {} resolution)))))
;; -----------------------------------------------------------------------------
;; Category 3: Multiple Libraries
;; -----------------------------------------------------------------------------
(t/deftest link-later-multiple-libraries-both-match
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
;; Create two libraries
lib1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
;; Create file linked to both
file (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Link file to both libraries
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib1)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib2)})
;; Export with link-later
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original libraries
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib1)})
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib2)})
;; Create new libraries with same names
(let [lib1b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib2b (th/create-file* 11 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Both libraries should be auto-linked
(t/is (some? file-res))
(t/is (= 2 (count (:done file-res))))
(t/is (= [] (:pending file-res)))
;; Verify both linked-to ids
(let [linked-ids (set (map :linked-to (:done file-res)))]
(t/is (contains? linked-ids (:id lib1b)))
(t/is (contains? linked-ids (:id lib2b))))))))
(t/deftest link-later-multiple-libraries-one-matches
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
file (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib1)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib2)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete both libraries
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib1)})
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib2)})
;; Only recreate Icons (not Colors)
(let [lib1b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Only Icons should be auto-linked
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id lib1b) (:linked-to (first (:done file-res)))))))))
(t/deftest link-later-multiple-libraries-both-multi-match
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
file (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib1)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib2)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original libraries
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib1)})
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib2)})
;; Create TWO of each library (multi-match)
(let [_ (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
_ (th/create-file* 11 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
_ (th/create-file* 12 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
_ (th/create-file* 13 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Both libraries should be pending (multi-match)
(t/is (some? file-res))
(t/is (= [] (:done file-res)))
(t/is (= 2 (count (:pending file-res))))
;; Each pending should have 2 candidates
(doseq [pending-entry (:pending file-res)]
(t/is (= 2 (count (:candidates pending-entry)))))))))
(t/deftest link-later-multiple-libraries-mixed-single-and-multi
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
file (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib1)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib2)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original libraries
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib1)})
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib2)})
;; Create ONE Icons (single match) and TWO Colors (multi-match)
(let [lib1b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
_ (th/create-file* 11 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
_ (th/create-file* 12 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Icons done, Colors pending
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id lib1b) (:linked-to (first (:done file-res)))))
(t/is (= 1 (count (:pending file-res))))
(t/is (= 2 (count (:candidates (first (:pending file-res))))))))))
;; -----------------------------------------------------------------------------
;; Category 4: Multiple Files
;; -----------------------------------------------------------------------------
(t/deftest link-later-multiple-files-same-library
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
file1 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file2 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Both files use the library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file1) :library-file-id (:id lib)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file2) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file1) (:id file2)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original library and recreate
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib)})
(let [lib-b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; Both files should have auto-linked
(t/is (= 2 (count (keys resolution))))
(doseq [[file-id file-res] resolution]
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id lib-b) (:linked-to (first (:done file-res))))))))))
(t/deftest link-later-multiple-files-only-one-uses-library
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
file1 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file2 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; Only file1 uses the library
(db/insert! th/*system* :file-library-rel
{:file-id (:id file1) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file1) (:id file2)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original library and recreate
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib)})
(let [lib-b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; Only file1 should have auto-linked
(let [files-with-done (filter #(seq (:done (val %))) resolution)]
(t/is (= 1 (count files-with-done)))
(let [[file-id file-res] (first files-with-done)]
(t/is (= (:id lib-b) (:linked-to (first (:done file-res)))))))))))
(t/deftest link-later-multiple-files-different-libraries
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib-icons (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib-colors (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
file1 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file2 (th/create-file* 4 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; file1 uses Icons, file2 uses Colors
(db/insert! th/*system* :file-library-rel
{:file-id (:id file1) :library-file-id (:id lib-icons)})
(db/insert! th/*system* :file-library-rel
{:file-id (:id file2) :library-file-id (:id lib-colors)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file1) (:id file2)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original libraries and recreate
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib-icons)})
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib-colors)})
(let [lib-icons-b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
lib-colors-b (th/create-file* 11 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Colors Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)]
;; Each file should have its respective library
(t/is (= 2 (count (keys resolution))))
(doseq [[file-id file-res] resolution]
(t/is (= 1 (count (:done file-res))))
(let [linked-id (:linked-to (first (:done file-res)))]
(t/is (or (= linked-id (:id lib-icons-b))
(= linked-id (:id lib-colors-b))))))))))
;; -----------------------------------------------------------------------------
;; Category 5: Permission Scenarios
;; -----------------------------------------------------------------------------
(t/deftest link-later-permission-viewer-cannot-link
(let [owner (th/create-profile* 1)
team (th/create-team* 1 {:profile-id (:id owner)})
viewer (th/create-profile* 2)
_ (th/create-team-role* {:team-id (:id team)
:profile-id (:id viewer)
:role :viewer})
project (th/create-project* 1 {:profile-id (:id owner)
:team-id (:id team)})
lib (th/create-file* 1 {:profile-id (:id owner)
:project-id (:id project)
:is-shared true
:name "Icons Library"})
file (th/create-file* 2 {:profile-id (:id owner)
:project-id (:id project)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import as viewer (no edit permission on library)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:id project))
(assoc ::bfc/profile-id (:id viewer))
(assoc ::bfc/team-id (:id team))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; No auto-link (viewer lacks edit permission)
(t/is (or (nil? file-res)
(= [] (:done file-res))))))))
(t/deftest link-later-permission-editor-can-link
(let [owner (th/create-profile* 1)
team (th/create-team* 1 {:profile-id (:id owner)})
editor (th/create-profile* 2)
_ (th/create-team-role* {:team-id (:id team)
:profile-id (:id editor)
:role :editor})
project (th/create-project* 1 {:profile-id (:id owner)
:team-id (:id team)})
lib (th/create-file* 1 {:profile-id (:id owner)
:project-id (:id project)
:is-shared true
:name "Icons Library"})
file (th/create-file* 2 {:profile-id (:id owner)
:project-id (:id project)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import as editor (has edit permission)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:id project))
(assoc ::bfc/profile-id (:id editor))
(assoc ::bfc/team-id (:id team))
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Auto-link should succeed
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))))))
;; -----------------------------------------------------------------------------
;; Category 6: Edge Cases
;; -----------------------------------------------------------------------------
(t/deftest link-later-edge-special-chars-in-name
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons & Buttons!"})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Verify slug in manifest
(let [manifest (v3/get-manifest th/*system* output)
ext-lib (first (:external-libraries manifest))]
(t/is (= "icons-buttons" (:slug ext-lib)))))))
(t/deftest link-later-edge-empty-slug-library
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
;; Library name that slugifies to empty
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "---"})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Library with empty slug should be dropped from external-libraries
(let [manifest (v3/get-manifest th/*system* output)
ext-libs (:external-libraries manifest)]
(t/is (or (nil? ext-libs)
(empty? ext-libs)))))))
(t/deftest link-later-edge-file-without-libraries
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
output (tmp/tempfile :suffix ".zip")]
;; Export file with no libraries
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Manifest should have no external-libraries
(let [manifest (v3/get-manifest th/*system* output)]
(t/is (nil? (:external-libraries manifest))))
;; Import should succeed with empty resolution
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input output)
(v3/import-files!))]
(t/is (= {} (:resolution result))))))
(t/deftest link-later-edge-case-insensitive-match
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "ICONS Library"})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete original and create with different case
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib)})
(let [lib-b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "icons library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Should match (slug is lowercase)
(t/is (some? file-res))
(t/is (= 1 (count (:done file-res))))
(t/is (= (:id lib-b) (:linked-to (first (:done file-res)))))))))
;; -----------------------------------------------------------------------------
;; Category 7: Reference Integrity
;; -----------------------------------------------------------------------------
(t/deftest link-later-reference-integrity-component-file-remapped
(let [{:keys [profile file-id team-id file]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Re-import in same team
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
new-file-id (first (:file-ids result))
resolution (:resolution result)
file-res (get resolution new-file-id)]
;; Verify auto-link happened
(t/is (= 1 (count (:done file-res))))
(let [linked-lib-id (:linked-to (first (:done file-res)))]
;; Get the imported file's data
(let [imported (:result (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id new-file-id
:components-v2 true}))
shapes (get-file-shapes (:data imported))]
;; Check that component-file references point to the new library
(doseq [shape shapes]
(when (contains? shape :component-file)
(t/is (= linked-lib-id (:component-file shape))
"component-file should reference the linked library"))))))))
(t/deftest link-later-reference-integrity-no-match-dangling-refs
(let [{:keys [profile file-id]} (import-sample-file)
team2 (th/create-team* 2 {:profile-id (:id profile)})
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Import in team 2 (no library exists)
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:id team2))
(assoc ::bfc/input output)
(v3/import-files!))
new-file-id (first (:file-ids result))]
;; Get the original library id from the manifest
(let [manifest (v3/get-manifest th/*system* output)
original-lib-id (:id (first (:external-libraries manifest)))]
;; Get the imported file's data
(let [imported (:result (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id new-file-id
:components-v2 true}))
file-data (:data imported)
pages (vals (:pages-index file-data))
all-shapes (mapcat vals (map :objects pages))
shapes-with-refs (filter #(contains? % :component-file) all-shapes)]
;; component-file refs should remain as original (dangling)
(t/is (seq shapes-with-refs) "expected shapes with component-file refs")
(doseq [shape shapes-with-refs]
(t/is (= original-lib-id (:component-file shape))
"component-file should remain as original UUID when no match")))))))
;; -----------------------------------------------------------------------------
;; Category 8: Resolution Structure Verification
;; -----------------------------------------------------------------------------
(t/deftest link-later-resolution-structure-single-file-single-lib
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete and recreate library
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib)})
(let [lib-b (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Verify exact structure
(t/is (map? file-res))
(t/is (= new-file-id (:id file-res)))
(t/is (some? (:name file-res)))
(t/is (vector? (:done file-res)))
(t/is (vector? (:pending file-res)))
(t/is (= 1 (count (:done file-res))))
;; Verify done entry structure
(let [done-entry (first (:done file-res))]
(t/is (contains? done-entry :id))
(t/is (contains? done-entry :name))
(t/is (contains? done-entry :linked-to))
(t/is (= (:id lib) (:id done-entry)))
(t/is (= "Icons Library" (:name done-entry)))
(t/is (= (:id lib-b) (:linked-to done-entry))))))))
(t/deftest link-later-resolution-structure-multi-match
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
lib (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(db/insert! th/*system* :file-library-rel
{:file-id (:id file) :library-file-id (:id lib)})
(let [output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Delete and create two libraries with same name
(db/update! th/*system* :file {:deleted-at (ct/now)} {:id (:id lib)})
(let [_ (th/create-file* 10 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
_ (th/create-file* 11 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true
:name "Icons Library"})
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
resolution (:resolution result)
new-file-id (first (:file-ids result))
file-res (get resolution new-file-id)]
;; Verify pending structure
(t/is (= [] (:done file-res)))
(t/is (= 1 (count (:pending file-res))))
(let [pending-entry (first (:pending file-res))]
(t/is (contains? pending-entry :id))
(t/is (contains? pending-entry :name))
(t/is (contains? pending-entry :candidates))
(t/is (= (:id lib) (:id pending-entry)))
(t/is (= "Icons Library" (:name pending-entry)))
(t/is (= 2 (count (:candidates pending-entry))))
;; Verify candidate structure
(doseq [candidate (:candidates pending-entry)]
(t/is (contains? candidate :id))
(t/is (contains? candidate :name))
(t/is (contains? candidate :project-id))
(t/is (contains? candidate :project-name))))))))
;; -----------------------------------------------------------------------------
;; Code Review Regression Tests: Reference Integrity Bug Fix
;; -----------------------------------------------------------------------------
(t/deftest link-later-multi-match-leaves-refs-dangling
(let [{:keys [profile file-id team-id library-id]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Create a SECOND library with the same name in the same team
(create-named-library th/*system* 2 team-id "LIbrary")
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Re-import in same team
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
new-file-id (first (:file-ids result))
resolution (:resolution result)
file-res (get resolution new-file-id)]
;; Multi-match should produce pending candidates, not auto-link
(t/is (seq (:pending file-res))
"multi-match should produce pending candidates")
(t/is (= [] (:done file-res))
"multi-match should NOT auto-link")
;; Refs must remain as original UUID (dangling), NOT remapped to any
;; of the candidate libraries
(let [manifest (v3/get-manifest th/*system* output)
original-lib-id (:id (first (:external-libraries manifest)))
imported (:result (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id new-file-id
:components-v2 true}))
file-data (:data imported)
pages (vals (:pages-index file-data))
all-shapes (mapcat vals (map :objects pages))
shapes-with-refs (filter #(contains? % :component-file) all-shapes)]
(t/is (seq shapes-with-refs) "expected shapes with component-file refs")
;; The key assertion: refs should NOT be remapped to any candidate
;; (they should remain as the original UUID from the manifest)
(let [slug (-> manifest :external-libraries first :slug)
matching (into #{} (map :id (bfc/find-shared-files-by-slug th/*system* team-id slug)))
candidate-ids (disj matching original-lib-id)]
(doseq [shape shapes-with-refs]
(t/is (not (contains? candidate-ids (:component-file shape)))
"component-file must NOT be remapped to any candidate library")
(t/is (= original-lib-id (:component-file shape))
"component-file must remain as original UUID on multi-match")))))))
(t/deftest link-later-no-edit-permission-leaves-refs-dangling
(let [{:keys [profile file-id team-id library-id]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Export file with link-later
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later))
(io/output-stream output))
;; Create a viewer profile (no edit permission on the library)
(let [viewer (th/create-profile* th/*system* 2 {})
_ (th/create-team-role* {:team-id team-id
:profile-id (:id viewer)
:role :viewer})]
;; Import as viewer
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id viewer))
(assoc ::bfc/team-id team-id)
(assoc ::bfc/input output)
(v3/import-files!))
new-file-id (first (:file-ids result))
resolution (:resolution result)
file-res (get resolution new-file-id)]
;; Viewer lacks edit permission, so no auto-link
(t/is (or (nil? file-res)
(= [] (:done file-res)))
"viewer should NOT auto-link")
;; Refs must remain as original UUID (dangling)
(let [manifest (v3/get-manifest th/*system* output)
original-lib-id (:id (first (:external-libraries manifest)))
imported (:result (th/command! {::th/type :get-file
::rpc/profile-id (:id viewer)
:id new-file-id
:components-v2 true}))
file-data (:data imported)
pages (vals (:pages-index file-data))
all-shapes (mapcat vals (map :objects pages))
shapes-with-refs (filter #(contains? % :component-file) all-shapes)]
(t/is (seq shapes-with-refs) "expected shapes with component-file refs")
(doseq [shape shapes-with-refs]
(t/is (= original-lib-id (:component-file shape))
"component-file must remain as original UUID when viewer has no edit permission")))))))
(t/deftest export-type-takes-precedence-over-legacy-boolean
(let [{:keys [file-id]} (import-sample-file)
output (tmp/tempfile :suffix ".zip")]
;; Call export with BOTH type=:link-later AND include-libraries=true
;; type should win
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type :link-later)
(assoc ::bfc/include-libraries true))
(io/output-stream output))
;; Verify manifest has external-libraries (only produced by link-later)
(let [manifest (v3/get-manifest th/*system* output)
ext-libs (:external-libraries manifest)]
(t/is (some? ext-libs)
"type :link-later should produce external-libraries even with include-libraries=true")
(t/is (pos? (count ext-libs))))))
(t/deftest import-rejects-too-many-zip-entries
;; import must reject ZIP files exceeding max-zip-entries (default-max-zip-entries)
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
;; Import with max-zip-entries=1 — the exported ZIP has more entries
(let [cfg (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(assoc ::bfc/import-max-zip-entries 1))
out (try
(v3/import-files! cfg)
:no-error
(catch Throwable e
(let [d (or (ex-data e) (some-> (ex-cause e) ex-data))]
d)))]
(t/is (= :validation (:type out)))
(t/is (= :too-many-zip-entries (:code out))))))
(defn- prepare-file-with-media
"Creates a file with a media object backed by a real storage object,
so that v3 export produces objects/ entries."
[profile]
(let [storage (-> (:app.storage/storage th/*system*)
(stt/configure-storage-backend))
sobject (sto/put-object! storage {::sto/content (sto/content "media-bytes")
:content-type "image/svg+xml"
:bucket "file-media-object"})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
mobj (th/create-file-media-object* {:file-id (:id file)
:is-local true
:media-id (:id sobject)})]
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-media
:object mobj}])
(dissoc file :data)))
(t/deftest import-rejects-oversized-object
;; import must reject storage objects exceeding default-max-binary-entry-size
(let [profile (th/create-profile* 1)
file (prepare-file-with-media profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/export-type :detach-libraries))
(io/output-stream output))
;; Import with max-binary-entry-size=1 — the media object will exceed this
(let [cfg (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(assoc ::bfc/import-max-binary-entry-size 1))
out (try
(v3/import-files! cfg)
:no-error
(catch Throwable e
(let [d (or (ex-data e) (some-> (ex-cause e) ex-data))]
d)))]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
;; --- GHSA-qcw7-v626-g6cf: decompression-bomb guards on JSON/text entries
(def ^:private bomb-entry-size
"Decompressed size of the test bomb entries. Over the 20 MiB default
per-entry limit, small enough to stay fast and lean under the guard."
(* 1024 1024 25))
(defn- write-bomb-entry!
"Writes a zip entry whose content is a single JSON string of `size` bytes
made of a repeated char. Streams in chunks, so neither the writer nor the
(guarded) reader ever needs to hold the full payload in memory. Compresses
~1:1000, like the reported exploit."
[^ZipOutputStream zos ^String entry-name ^long size]
(.putNextEntry zos (ZipEntry. entry-name))
(let [w (OutputStreamWriter. zos "UTF-8")
chunk (apply str (repeat 8192 \A))]
(.write w "\"")
(loop [remaining size]
(when (pos? remaining)
(let [n (min remaining (count chunk))]
(.write ^Writer w ^String chunk (int 0) (int n))
(recur (- remaining n)))))
(.write w "\"")
(.flush w))
(.closeEntry zos))
(defn- replace-zip-entry!
"Copies the zip at `src-path` to `dst-path`, replacing the entry
`entry-name` with a bomb entry of `bomb-size` decompressed bytes."
[src-path dst-path entry-name bomb-size]
(with-open [zin (ZipFile. (fs/file src-path))
out (io/output-stream dst-path)
zos (ZipOutputStream. out)]
(.setLevel zos Deflater/BEST_COMPRESSION)
(doseq [entry (iterator-seq (.entries zin))]
(let [entry-name' (.getName ^ZipEntry entry)]
(if (= entry-name' entry-name)
(write-bomb-entry! zos entry-name bomb-size)
(do
(.putNextEntry zos (ZipEntry. entry-name'))
(with-open [in (.getInputStream zin entry)]
(io/copy in zos))
(.closeEntry zos)))))))
(defn- try-import-files!
"Runs v3/import-files! and returns the ex-data of the raised error,
or :no-error when the import unexpectedly succeeds."
[cfg]
(try
(v3/import-files! cfg)
:no-error
(catch Throwable e
(or (ex-data e) (some-> (ex-cause e) ex-data)))))
(t/deftest import-rejects-oversized-json-entry
;; GHSA-qcw7-v626-g6cf: a single files/<id>.json entry expanding beyond
;; the per-entry text limit must be rejected with :max-file-size-reached
;; instead of exhausting the heap. The manifest comes from a real export
;; so it is valid; only the file entry is replaced by the bomb.
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
exported (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream exported))
(let [bombed (tmp/tempfile :suffix ".zip")]
(replace-zip-entry! exported bombed
(str "files/" (:id file) ".json")
bomb-entry-size)
(let [cfg (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input bombed))
out (try-import-files! cfg)]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out)))))))
(t/deftest get-manifest-rejects-oversized-manifest
;; GHSA-qcw7-v626-g6cf: the synchronous manifest read on the RPC thread
;; (v3/get-manifest) must reject a manifest.json bomb the same way.
;; Decoding/validation is never reached, so the payload needs no schema.
(let [bombed (tmp/tempfile :suffix ".zip")]
(with-open [out (io/output-stream bombed)
zos (ZipOutputStream. out)]
(.setLevel zos Deflater/BEST_COMPRESSION)
(write-bomb-entry! zos "manifest.json" bomb-entry-size))
(let [out (try
(v3/get-manifest th/*system* bombed)
:no-error
(catch Throwable e
(or (ex-data e) (some-> (ex-cause e) ex-data))))]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
(t/deftest import-rejects-excessive-total-text-size
;; The job-wide cumulative budget must reject an import whose entries,
;; each individually under the per-entry cap, exceed the total limit.
;; A tiny total budget over a legitimate small export proves the
;; cumulative counter fires independently of the per-entry guard.
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
output (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream output))
(let [cfg (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(assoc ::bfc/import-max-text-total-size 100))
out (try-import-files! cfg)]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
(defn- text-entries-sizes
"Returns the decompressed sizes of every `.json` entry in the zip at
`zip-path`. Used to pick a cumulative budget that sits between the
largest single entry and the summed total."
[zip-path]
(with-open [zin (ZipFile. (fs/file zip-path))]
(->> (iterator-seq (.entries zin))
(filter #(.endsWith ^String (.getName ^ZipEntry %) ".json"))
(map #(.getSize ^ZipEntry %))
(remove neg?)
vec)))
(t/deftest import-rejects-accumulated-text-across-entries
;; The cumulative budget must account bytes across entries sharing one
;; counter: a budget just over the largest single entry (so no entry
;; alone can trip it) but under the summed total (so the running total
;; must trip it) is rejected. If the shared counter ever regressed to
;; a fresh atom per entry, every entry alone would pass and the valid
;; import would succeed, so this test would go red.
(let [profile (th/create-profile* 1)
file (prepare-simple-file profile)
exported (tmp/tempfile :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream exported))
(let [sizes (text-entries-sizes exported)
max-single (apply max 0 sizes)
summed (reduce + 0 sizes)
budget (inc max-single)]
;; Preconditions that make the test meaningful: more than one
;; entry worth of text, so the trip can only come from
;; accumulation, never from a single entry.
(t/is (> summed budget))
(let [cfg (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input exported)
(assoc ::bfc/import-max-text-total-size budget))
out (try-import-files! cfg)]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out)))
(t/is (some? (:path out)))))))
(t/deftest size-limiting-stream-counts-skip
;; Skipped bytes were already decompressed, so they must count against
;; the budget like read bytes do.
(let [payload (.getBytes "abcdefghijklmnopqrstuvwxyz" "UTF-8")
mk-stream (fn [cap]
(@#'v3/size-limiting-stream
(ByteArrayInputStream. payload) cap (atom 0) "test-entry"))]
;; Skipping past the cap trips the guard.
(let [out (try
(with-open [s (mk-stream 10)]
(.skip ^java.io.InputStream s 20)
:no-error)
(catch clojure.lang.ExceptionInfo e
(ex-data e)))]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out)))
(t/is (= "test-entry" (:path out))))
;; Skipping under the cap leaves the remainder accounted: 6 skipped
;; plus 10 read over a cap of 10 trips the guard.
(let [out (try
(with-open [s (mk-stream 10)]
(.skip ^java.io.InputStream s 6)
(.read ^java.io.InputStream s (byte-array 10))
:no-error)
(catch clojure.lang.ExceptionInfo e
(ex-data e)))]
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
(t/deftest import-configures-finite-transaction-idle-timeout
;; The binfile import transaction must set a finite ceiling for
;; idle_in_transaction_session_timeout (20 min) instead of disabling
;; it entirely: a stalled import must not retain a pool connection
;; without any upper bound. The ceiling must be scoped with SET
;; LOCAL: once the transaction ends, the pool session default must
;; be restored for subsequent transactions.
(let [pg-setting-sql ["SELECT setting FROM pg_settings WHERE name = 'idle_in_transaction_session_timeout'"]
in-tx (db/tx-run! th/*system*
(fn [cfg]
(bfc/configure-database-timeouts! cfg)
(:setting (db/exec-one! cfg pg-setting-sql))))
;; SET LOCAL must not leak past the transaction boundary
after (db/tx-run! th/*system*
(fn [cfg]
(:setting (db/exec-one! cfg pg-setting-sql))))]
(t/is (= "1200000" in-tx))
(t/is (= "300000" after))))
(def ^:private index-test-file-id "22222222-2222-2222-2222-222222222222")
(def ^:private index-test-page-id "44444444-4444-4444-4444-444444444444")
(defn- index-entries-of
[names]
(@#'v3/index-entries (map #(java.util.zip.ZipEntry. %) names)))
(t/deftest index-entries-classifies-entry-names
(let [f index-test-file-id
page index-test-page-id
index (index-entries-of
["manifest.json"
(str "files/" f ".json")
(str "files/" f "/plugin-data.json")
(str "files/" f "/tokens.json")
"objects/11111111-1111-1111-1111-111111111111.json"
(str "files/" f "/media/33333333-3333-3333-3333-333333333333.json")
(str "files/" f "/colors/not-a-uuid.json")
(str "files/" f "/components/comp.json")
(str "files/" f "/typographies/t.json")
(str "files/" f "/pages/" page ".json")
(str "files/" f "/pages/" page "/shape.json")
(str "files/" f "/thumbnails/medium/" page "/frame.json")])]
(t/is (= [(parse-uuid "11111111-1111-1111-1111-111111111111")]
(mapv :id (:objects index))))
(t/is (= #{f} (set (keys (:media index)))))
(t/is (= [(parse-uuid "33333333-3333-3333-3333-333333333333")]
(mapv :id (get (:media index) f))))
(t/is (= #{f} (set (keys (:colors index)))))
;; non-uuid ids are preserved as nil, same as the matchers do today
(t/is (= [nil] (mapv :id (get (:colors index) f))))
(t/is (= #{f} (set (keys (:components index)))))
(t/is (= #{f} (set (keys (:typographies index)))))
(t/is (= #{f} (set (keys (:pages index)))))
(t/is (= [(parse-uuid page)] (mapv :id (get (:pages index) f))))
(t/is (= #{f} (set (keys (:shapes index)))))
(t/is (= #{page} (set (keys (get (:shapes index) f)))))
(t/is (= [nil] (mapv :id (get (get (:shapes index) f) page))))
(t/is (= #{f} (set (keys (:thumbnails index)))))
(let [thumb (first (get (:thumbnails index) f))]
(t/is (= "medium" (:tag thumb)))
(t/is (= (parse-uuid page) (:page-id thumb)))
(t/is (= (parse-uuid "frame") (:frame-id thumb)))
(t/is (= f (:file-id thumb))))
(t/is (= #{f} (set (keys (:tokens index)))))))
(t/deftest index-entries-ignores-unknown-entry-names
;; unknown paths, wrong depth, wrong suffix or non-uuid file segments
;; are all ignored, same as today's anchored regexes
(t/is (empty? (index-entries-of ["manifest.json"])))
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id ".json")])))
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id "/plugin-data.json")])))
(t/is (empty? (index-entries-of ["objects/a/b.json"])))
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id "/media/a/b.json")])))
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id "/media/a.txt")])))
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id "/unknown/a.json")])))
(t/is (empty? (index-entries-of [(str "files//media/a.json")]))))
(t/deftest index-entries-requires-literal-json-suffix
;; deliberate tightening vs today's regexes: the dot is unescaped in
;; `([^/]+).json$` / `tokens.json$`, so today `tokensXjson` and
;; `objects/x-json` DO match; the classifier requires a literal
;; `.json` suffix and ignores them
(t/is (empty? (index-entries-of [(str "files/" index-test-file-id "/tokensXjson")])))
(t/is (empty? (index-entries-of ["objects/x-json"]))))
(t/deftest import-binfile-v3-multiple-files-preserves-per-file-content
;; the entries index must attribute every zip entry to the file it
;; belongs to: with several files in the same manifest, pages and
;; shapes of one file must not leak into another. The file also
;; carries library content (color, typography, component and tokens
;; set) so every rewired consumer is exercised on its present path.
(let [profile (th/create-profile* 1)
simple (prepare-simple-file profile)
color-id (uuid/custom 5 1)
typo-id (uuid/custom 5 2)
comp-id (uuid/custom 5 3)
svg (prepare-svg-raw-file profile 2)
output (tmp/tempfile :suffix ".zip")]
(update-file!
:file-id (:id simple)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-color
:color {:id color-id
:name "import-color"
:color "#FF0000"}}
{:type :add-typography
:typography {:id typo-id
:name "import-typography"
:font-id "source-sans-pro"
:font-family "Source Sans Pro"
:font-variant-id "regular"
:font-size "16"
:font-weight "400"
:font-style "normal"
:line-height "1.4"
:letter-spacing "0"
:text-transform "none"}}
{:type :add-component
:id comp-id
:name "import-component"
:path ""
:main-instance-id (uuid/custom 2 1)
:main-instance-page (uuid/custom 1 1)}
{:type :set-tokens-lib
:tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "ImportSet")))}])
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id simple) (:id svg)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream output))
;; import returns the imported file ids plus the library link
;; resolution; the test only needs the ids
(let [result (:file-ids (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(v3/import-files!)))
files (map #(bfc/get-file th/*system* %) result)
svg-imported (some #(when (contains? (get-in % [:data :pages-index
svg-raw-page-id
:objects])
svg-raw-root-id)
%)
files)
simple-imported (some #(when (contains? (get-in % [:data :pages-index
(uuid/custom 1 1)
:objects])
(uuid/custom 2 1))
%)
files)]
(t/is (= 2 (count result)))
(t/is (= 2 (count (distinct result))))
(t/is (some? svg-imported))
(t/is (some? simple-imported))
;; the svg-raw file keeps its subtree on its own page (plus the
;; default page created by create-file)
(t/is (= [svg-raw-child-id]
(get-in svg-imported [:data :pages-index svg-raw-page-id
:objects svg-raw-root-id :shapes])))
(t/is (= 2 (count (get-in svg-imported [:data :pages-index]))))
;; the simple file keeps its default page plus its two pages and
;; its shape
(t/is (= 3 (count (get-in simple-imported [:data :pages-index]))))
(t/is (contains? (get-in simple-imported
[:data :pages-index (uuid/custom 1 1) :objects])
(uuid/custom 2 1)))
;; library content is restored on its present path: the
;; consumers' get-in keys must match the classifier buckets
(t/is (some? (get-in simple-imported [:data :colors color-id])))
(t/is (some? (get-in simple-imported [:data :typographies typo-id])))
(t/is (some? (get-in simple-imported [:data :components comp-id])))
(t/is (= ["ImportSet"]
(vec (ctob/get-set-names
(get-in simple-imported [:data :tokens-lib]))))))))
(t/deftest import-binfile-v3-restores-media-objects
;; storage objects, per-file media entries and object thumbnails
;; are classified through the entries index and restored end to end
(let [profile (th/create-profile* 1)
file (prepare-file-with-media profile)
thumb-page-id (uuid/custom 1 1)
thumb-frame-id (uuid/custom 6 1)
thumb-tag "medium"
output (tmp/tempfile :suffix ".zip")]
;; a thumbnail row backed by the same storage object as the media
;; object, so the export produces a thumbnails/ zip entry
(let [mobj (th/db-get :file-media-object {:file-id (:id file)})]
(db/insert! th/*system* :file-tagged-object-thumbnail
{:file-id (:id file)
:tag thumb-tag
:object-id (thc/fmt-object-id {:file-id (:id file)
:page-id thumb-page-id
:frame-id thumb-frame-id
:tag thumb-tag})
:media-id (:media-id mobj)}))
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream output))
;; import returns the imported file ids plus the library link
;; resolution; the test only needs the ids
(let [result (:file-ids (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input output)
(v3/import-files!)))
mobjs (db/query th/*system* :file-media-object
{:file-id (first result)})
thumbs (db/query th/*system* :file-tagged-object-thumbnail
{:file-id (first result)})]
(t/is (= 1 (count result)))
(t/is (pos? (count mobjs)))
(t/is (every? some? (map :media-id mobjs)))
;; the thumbnail is restored with its object-id rebuilt around
;; the new file id and a media-id that resolves to storage
(t/is (= 1 (count thumbs)))
(let [thumb (first thumbs)]
(t/is (= thumb-tag (:tag thumb)))
(t/is (= (str (first result) "/" thumb-page-id "/" thumb-frame-id "/" thumb-tag)
(:object-id thumb)))
(t/is (some? (:media-id thumb)))))))
Reference in New Issue View Git Blame Copy Permalink