WIP

✨ Make the hash optional on binfile-v3

.circleci/config.yml

@@ -1,5 +1,53 @@
 version: 2.1
+
 jobs:
+  lint:
+    docker:
+      - image: penpotapp/devenv:latest
+
+    working_directory: ~/repo
+    resource_class: medium+
+
+    steps:
+      - checkout
+
+      - run:
+          name: "fmt check"
+          working_directory: "."
+          command: |
+            yarn install
+            yarn run fmt:clj:check
+
+      - run:
+          name: "lint clj common"
+          working_directory: "."
+          command: |
+            yarn run lint:clj:common
+
+      - run:
+          name: "lint clj frontend"
+          working_directory: "."
+          command: |
+            yarn run lint:clj:frontend
+
+      - run:
+          name: "lint clj backend"
+          working_directory: "."
+          command: |
+            yarn run lint:clj:backend
+
+      - run:
+          name: "lint clj exporter"
+          working_directory: "."
+          command: |
+            yarn run lint:clj:exporter
+
+      - run:
+          name: "lint clj library"
+          working_directory: "."
+          command: |
+            yarn run lint:clj:library
+
   test-common:
     docker:
       - image: penpotapp/devenv:latest
@@ -17,15 +65,7 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
           keys:
-            - v1-dependencies-{{ checksum "common/deps.edn"}}
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run lint:clj
+            - v1-dependencies-{{ checksum "common/deps.edn"}}-{{ checksum "common/yarn.lock" }}
 
       - run:
           name: "JVM tests"
@@ -37,12 +77,16 @@ jobs:
           name: "NODE tests"
           working_directory: "./common"
           command: |
+            yarn install
             yarn run test
 
       - save_cache:
           paths:
             - ~/.m2
-          key: v1-dependencies-{{ checksum "common/deps.edn"}}
+            - ~/.yarn
+            - ~/.gitlibs
+            - ~/.cache/ms-playwright
+          key: v1-dependencies-{{ checksum "common/deps.edn"}}-{{ checksum "common/yarn.lock" }}
 
   test-frontend:
     docker:
@@ -61,36 +105,36 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
           keys:
-            - v1-dependencies-{{ checksum "frontend/deps.edn"}}
+            - v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
 
       - run:
-          name: "prepopulate linter cache"
-          working_directory: "./common"
+          name: "install dependencies"
+          working_directory: "./frontend"
+          # We install playwright here because the dependent tasks
+          # uses the same cache as this task so we prepopulate it
           command: |
             yarn install
-            yarn run lint:clj
+            yarn run playwright install chromium
 
       - run:
-          name: "fmt check & linter"
+          name: "lint scss on frontend"
           working_directory: "./frontend"
           command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run fmt:js:check
             yarn run lint:scss
-            yarn run lint:clj
 
       - run:
           name: "unit tests"
           working_directory: "./frontend"
           command: |
-            yarn install
             yarn run test
 
       - save_cache:
           paths:
             - ~/.m2
-          key: v1-dependencies-{{ checksum "frontend/deps.edn"}}
+            - ~/.yarn
+            - ~/.gitlibs
+            - ~/.cache/ms-playwright
+          key: v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
 
   test-components:
     docker:
@@ -109,14 +153,14 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
           keys:
-            - v1-dependencies-{{ checksum "frontend/deps.edn"}}
+            - v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
 
       - run:
           name: Install dependencies
           working_directory: "./frontend"
           command: |
-            yarn
-            npx playwright install --with-deps
+            yarn install
+            yarn run playwright install chromium
 
       - run:
           name: Build Storybook
@@ -148,7 +192,7 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
           keys:
-            - v1-dependencies-{{ checksum "frontend/deps.edn"}}
+            - v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
 
       - run:
           name: "integration tests"
@@ -158,7 +202,7 @@ jobs:
             yarn run build:app:assets
             yarn run build:app
             yarn run build:app:libs
-            yarn run playwright install --with-deps chromium
+            yarn run playwright install chromium
             yarn run test:e2e -x --workers=4
 
   test-backend:
@@ -185,21 +229,6 @@ jobs:
           keys:
             - v1-dependencies-{{ checksum "backend/deps.edn" }}
 
-      - run:
-          name: "prepopulate linter cache"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run lint:clj
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./backend"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run lint:clj
-
       - run:
           name: "tests"
           working_directory: "./backend"
@@ -215,37 +244,9 @@ jobs:
       - save_cache:
           paths:
             - ~/.m2
+            - ~/.gitlibs
           key: v1-dependencies-{{ checksum "backend/deps.edn" }}
 
-  test-exporter:
-    docker:
-      - image: penpotapp/devenv:latest
-
-    working_directory: ~/repo
-    resource_class: medium+
-
-    environment:
-      JAVA_OPTS: -Xmx4g -Xms100m -XX:+UseSerialGC
-      NODE_OPTIONS: --max-old-space-size=4096
-
-    steps:
-      - checkout
-
-      - run:
-          name: "prepopulate linter cache"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run lint:clj
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./exporter"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run lint:clj
-
   test-render-wasm:
     docker:
       - image: penpotapp/devenv:latest
@@ -278,10 +279,27 @@ jobs:
 workflows:
   penpot:
     jobs:
-      - test-frontend
-      - test-components
-      - test-integration
-      - test-backend
-      - test-common
-      - test-exporter
+      - lint
+      - test-frontend:
+          requires:
+            - lint: success
+
+      - test-components:
+          requires:
+            - test-frontend: success
+            - lint: success
+
+      - test-integration:
+          requires:
+            - test-frontend: success
+            - lint: success
+
+      - test-backend:
+          requires:
+            - lint: success
+
+      - test-common:
+          requires:
+            - lint: success
+
       - test-render-wasm

.github/workflows/commit-checker.yml

@@ -26,7 +26,7 @@ jobs:
       - name: Check Commit Type
         uses: gsactions/commit-message-checker@v2
         with:
-          pattern: '^:(lipstick|globe_with_meridians|wrench|books|arrow_up|arrow_down|zap|ambulance|construction|boom|fire|whale|bug|sparkles|paperclip|tada|recycle):\s[A-Z].*[^.]$'
+          pattern: '^(Merge|:(lipstick|globe_with_meridians|wrench|books|arrow_up|arrow_down|zap|ambulance|construction|boom|fire|whale|bug|sparkles|paperclip|tada|recycle):)\s[A-Z].*[^.]$'
           flags: 'gm'
           error: 'Commit should match CONTRIBUTING.md guideline'
           checkAllCommitMessages: 'true' # optional: this checks all commits associated with a pull request

.gitignore

@@ -68,6 +68,8 @@
 /vendor/**/target
 /vendor/svgclean/bundle*.js
 /web
+/library/target/
+
 clj-profiler/
 node_modules
 /test-results/

CHANGES.md

@@ -6,46 +6,57 @@
 
 ### :boom: Breaking changes & Deprecations
 
-**Breaking changes on penpot library:**
+**Penpot Library**
 
-- Change the signature of the `addPage` method: it now accepts an object (as a single argument) where you can pass `id`,
-  `name`, and `background` props (instead of the previous positional arguments)
-- Rename the `file.createRect` method to `file.addRect`
-- Rename the `file.createCircle` method to `file.addCircle`
-- Rename the `file.createPath` method to `file.addPath`
-- Rename the `file.createText` method to `file.addText`
-- Rename `file.startComponent` to `file.addComponent` (to preserve the naming style)
-- Rename `file.createComponentInstance` to `file.addComponentInstance` (to preserve the naming style)
-- Rename `file.lookupShape` to `file.getShape`
-- Rename `file.asMap` to `file.toMap`
-- Remove `file.updateLibraryColor` (use `file.addLibraryColor` if you just need to replace a color)
-- Remove `file.deleteLibraryColor` (this library is intended to build files)
-- Remove `file.updateLibraryTypography` (use `file.addLibraryTypography` if you just need to replace a typography)
-- Remove `file.deleteLibraryTypography` (this library is intended to build files)
-- Remove `file.add/update/deleteLibraryMedia` (they are no longer supported by Penpot and have been replaced by components)
-- Remove `file.deleteObject` (this library is intended to build files)
-- Remove `file.updateObject` (this library is intended to build files)
-- Remove `file.finishComponent` (it is no longer necessary; see below for more details on component creation changes)
-- Change the `file.getCurrentPageId` function to a read-only `file.currentPageId` property
-- Add `file.currentFrameId` read-only property
-- Add `file.lastId` read-only property
-
-There are also relevant semantic changes in how components should be created: this refactor removes
-all notions of the old components (v1). Since v2, the shapes that are part of a component live on a
-page. So, from now on, to create a component, you should first create a frame, then add shapes
-and/or groups to that frame, and then create a component by declaring that frame as the component
-root.
+The initial prototype is completly reworked for provide a more consistent API
+and to have proper validation and params decoding. All the details can be found
+on [its own changelog](library/CHANGES.md)
 
 ### :heart: Community contributions (Thank you!)
 
 ### :sparkles: New features
 
 - Optimize profile setup flow for better user experience [Taiga #10028](https://tree.taiga.io/project/penpot/us/10028)
+- Update base image for Docker Backend and Exporter to Ubuntu 24.04
+- Update base image for Docker Frontend to Nginx 1.28.0
+- Allow multi file token import [Github #27](https://github.com/tokens-studio/penpot/issues/27)
+- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
+- Deselect layers (and path nodes) with Ctrl+Shift+Drag [Github #2509](https://github.com/penpot/penpot/issues/2509)
+- Copy to SVG from contextual menu [Github #838](https://github.com/penpot/penpot/issues/838)
+- Add styles for Inkeep Chat at workspace [Taiga #10708](https://tree.taiga.io/project/penpot/us/10708)
+- On components overrides, separate the content of the text from the rest of properties [Taiga #7434](https://tree.taiga.io/project/penpot/us/7434)
+- Add configuration for air gapped installations with Docker
+- Support system color scheme [Github #5030](https://github.com/penpot/penpot/issues/5030)
+- Persist ruler visibility across files and reloads [GitHub #4586](https://github.com/penpot/penpot/issues/4586)
+- Update google fonts (at 2025/05/19) [Taiga 10792](https://tree.taiga.io/project/penpot/us/10792)
+
+### :bug: Bugs fixed
+- Fix getCurrentUser for plugins api [Taiga #11057](https://tree.taiga.io/project/penpot/issue/11057)
+- Fix spacing / sizes of different elements in the measurements section of the design tab [Taiga #11076](https://tree.taiga.io/project/penpot/issue/11076)
+- Fix selection of short paths [Github #4472](https://github.com/penpot/penpot/issues/4472)
+- Fix element positioning on the right side to adjust to grid [#11073](https://tree.taiga.io/project/penpot/issue/11073)
+- Fix palette is over sidebar [#11160](https://tree.taiga.io/project/penpot/issue/11160)
+- Fix font size input not displaying "mixed" when multiple texts are selected [Taiga #11177](https://tree.taiga.io/project/penpot/issue/11177)
+
+
+## 2.7.2 (Unreleased)
 
 ### :bug: Bugs fixed
 
+- Update plugins runtime [Github #6604](https://github.com/penpot/penpot/pull/6604)
+- Backport from develop a minor fix that enables import of files
+  generated by penpot library [Github #6614](https://github.com/penpot/penpot/pull/6614)
 
-## 2.7.0 (Unreleased)
+
+## 2.7.1
+
+### :bug: Bugs fixed
+
+- Fix incorrect handling of strokes with images on importing files
+- Fix tokens disappearing after manual additions [Taiga #11063](https://tree.taiga.io/project/penpot/issue/11063)
+
+
+## 2.7.0
 
 ### :rocket: Epics and highlights
 
@@ -63,10 +74,10 @@ root.
 - Duplicate token sets [Taiga #10694](https://tree.taiga.io/project/penpot/issue/10694)
 - Add set selection in create Token themes flow [Taiga #10746](https://tree.taiga.io/project/penpot/issue/10746)
 - Display indicator on not active sets [Taiga #10668](https://tree.taiga.io/project/penpot/issue/10668)
-- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
 
 ### :bug: Bugs fixed
 
+- Fix "at" icon to match all icons on app [Taiga #11136](https://tree.taiga.io/project/penpot/issue/11136)
 - Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
 - Fix resize bar background on tokens panel [Taiga #10811](https://tree.taiga.io/project/penpot/issue/10811)
 - Fix shortcut for history version panel [Taiga #11006](https://tree.taiga.io/project/penpot/issue/11006)
@@ -93,6 +104,13 @@ root.
 - Fix cannot rename Design Token Sets when group of same name exists [Taiga Issue #10773](https://tree.taiga.io/project/penpot/issue/10773)
 - Fix problem when duplicating grid layout [Github #6391](https://github.com/penpot/penpot/issues/6391)
 - Fix issue that makes workspace shortcuts stop working [Taiga #11062](https://tree.taiga.io/project/penpot/issue/11062)
+- Fix problem while syncing library colors and typographies [Taiga #11068](https://tree.taiga.io/project/penpot/issue/11068)
+- Fix problem with path edition of shapes [Taiga #9496](https://tree.taiga.io/project/penpot/issue/9496)
+- Fix exception on paste invalid html [Taiga #11047](https://tree.taiga.io/project/penpot/issue/11047)
+- Fix share button being displayed with no permissions [Taiga #11086](https://tree.taiga.io/project/penpot/issue/11086)
+- Fix inline styles in code tab [Taiga Issue #7583](https://tree.taiga.io/project/penpot/issue/7583)
+- Fix exception on returning openapi.json
+- Fix json encoding of TokensLib [Taiga #10994](https://tree.taiga.io/project/penpot/issue/10994)
 
 ## 2.6.2
 

CODE_OF_CONDUCT.md

@@ -0,0 +1,3 @@
+# Penpot's Code of Conduct
+
+Check it at: https://help.penpot.app/contributing-guide/coc/

CONTRIBUTING.md

@@ -1,62 +1,59 @@
 # Contributing Guide #
 
 Thank you for your interest in contributing to Penpot. This is a
-generic guide that details how to contribute to Penpot in a way that
-is efficient for everyone. If you want a specific documentation for
-different parts of the platform, please refer to `docs/` directory.
-
+generic guide that details how to contribute to the project in a way that
+is efficient for everyone. If you are looking for specific documentation on
+different parts of the platform, please refer to the `docs/` directory,
+or the rendered version at the [Help Center](https://help.penpot.app/).
 
 ## Reporting Bugs ##
 
 We are using [GitHub Issues](https://github.com/penpot/penpot/issues)
-for our public bugs. We keep a close eye on this and try to make it
+for our public bugs. We keep a close eye on them and try to make it
 clear when we have an internal fix in progress. Before filing a new
 task, try to make sure your problem doesn't already exist.
 
-If you found a bug, please report it, as far as possible with:
+If you found a bug, please report it, as far as possible, with:
 
 - a detailed explanation of steps to reproduce the error
-- a browser and the browser version used
-- a dev tools console exception stack trace (if it is available)
+- the browser and browser version used
+- a dev tools console exception stack trace (if available)
 
-If you found a bug that you consider better discuss in private (for
-example: security bugs), consider first send an email to
+If you found a bug which you think is better to discuss in private (for
+example, security bugs), consider first sending an email to
 `support@penpot.app`.
 
-**We don't have formal bug bounty program for security reports; this
-is an open source application and your contribution will be recognized
+**We don't have a formal bug bounty program for security reports; this
+is an open source application, and your contribution will be recognized
 in the changelog.**
 
 
-## Pull requests ##
+## Pull Requests ##
 
-If you want propose a change or bug fix with the Pull-Request system
-firstly you should carefully read the **DCO** section and format your
-commits accordingly.
+If you want to propose a change or bug fix via a pull request (PR),
+you should first carefully read the section **Developer's Certificate of
+Origin**. You must also format your code and commits according to the
+instructions below.
 
-If you intend to fix a bug it's fine to submit a pull request right
-away but we still recommend to file an issue detailing what you're
+If you intend to fix a bug, it's fine to submit a pull request right
+away, but we still recommend filing an issue detailing what you're
 fixing. This is helpful in case we don't accept that specific fix but
 want to keep track of the issue.
 
-If you want to implement or start working in a new feature, please
-open a **question** / **discussion** issue for it. No pull-request
-will be accepted without previous chat about the changes,
-independently if it is a new feature, already planned feature or small
-quick win.
+If you want to implement or start working on a new feature, please
+open a **question*- / **discussion*- issue for it. No PR
+will be accepted without a prior discussion about the changes,
+whether it is a new feature, an already planned one, or a quick win.
 
-If is going to be your first pull request, You can learn how from this
-free video series:
-
-https://egghead.io/courses/how-to-contribute-to-an-open-source-project-on-github
-
-We will use the `easy fix` mark for tag for indicate issues that are
-easy for beginners.
+If it is your first PR, you can learn how to proceed from
+[this free video
+series](https://egghead.io/courses/how-to-contribute-to-an-open-source-project-on-github)
 
+We use the `easy fix` tag to indicate issues that are appropriate for beginners.
 
 ## Commit Guidelines ##
 
-We have very precise rules over how our git commit messages can be formatted.
+We have very precise rules on how our git commit messages must be formatted.
 
 The commit message format is:
 
@@ -71,34 +68,37 @@ The commit message format is:
 Where type is:
 
 - :bug: `:bug:` a commit that fixes a bug
-- :sparkles: `:sparkles:` a commit that an improvement
-- :tada: `:tada:` a commit with new feature
+- :sparkles: `:sparkles:` a commit that adds an improvement
+- :tada: `:tada:` a commit with a new feature
 - :recycle: `:recycle:` a commit that introduces a refactor
 - :lipstick: `:lipstick:` a commit with cosmetic changes
-- :ambulance: `:ambulance:` a commit that fixes critical bug
+- :ambulance: `:ambulance:` a commit that fixes a critical bug
 - :books: `:books:` a commit that improves or adds documentation
-- :construction: `:construction:`: a wip commit
+- :construction: `:construction:` a WIP commit
 - :boom: `:boom:` a commit with breaking changes
 - :wrench: `:wrench:` a commit for config updates
 - :zap: `:zap:` a commit with performance improvements
-- :whale: `:whale:` a commit for docker related stuff
-- :paperclip: `:paperclip:` a commit with other not relevant changes
-- :arrow_up: `:arrow_up:` a commit with dependencies updates
-- :arrow_down: `:arrow_down:` a commit with dependencies downgrades
+- :whale: `:whale:` a commit for Docker-related stuff
+- :paperclip: `:paperclip:` a commit with other non-relevant changes
+- :arrow_up: `:arrow_up:` a commit with dependency updates
+- :arrow_down: `:arrow_down:` a commit with dependency downgrades
 - :fire: `:fire:` a commit that removes files or code
+- :globe_with_meridians: `:globe_with_meridians:` a commit that adds or updates
+  translations
 
 More info:
+
  - https://gist.github.com/parmentf/035de27d6ed1dce0b36a
  - https://gist.github.com/rxaviers/7360908
 
 Each commit should have:
 
-- A concise subject using imperative mood.
-- The subject should have capitalized the first letter, without period
-  at the end and no larger than 65 characters.
+- A concise subject using the imperative mood.
+- The subject should capitalize the first letter, omit the period
+  at the end, and be no longer than 65 characters.
 - A blank line between the subject line and the body.
-- An entry on the CHANGES.md file if applicable, referencing the
-  github or taiga issue/user-story using the these same rules.
+- An entry in the CHANGES.md file if applicable, referencing the
+  GitHub or Taiga issue/user story using these same rules.
 
 Examples of good commit messages:
 
@@ -111,8 +111,30 @@ Examples of good commit messages:
 - `:ambulance: Fix critical bug on user registration process`
 - `:tada: Add new approach for user registration`
 
+## Formatting and Linting ##
 
-## Code of conduct ##
+You will want to make sure your code is formatted and linted before submitting
+a PR. We use [cljfmt](https://github.com/weavejester/cljfmt) and
+[clj-kondo](https://github.com/clj-kondo/clj-kondo) for this. After installing
+them on your system, you can run them with:
+
+```bash
+# Check formatting
+yarn fmt:clj:check
+
+# Check and fix formatting
+yarn fmt:clj
+
+# Run the linter
+yarn lint:clj
+```
+
+There are more choices in `package.json`.
+
+Ideally, you should run these commands as git pre-commit hooks. A convenient way
+of defining them is to use [Husky](https://typicode.github.io/husky/#/).
+
+## Code of Conduct ##
 
 As contributors and maintainers of this project, we pledge to respect
 all people who contribute through reporting issues, posting feature
@@ -132,11 +154,11 @@ unprofessional conduct.
 
 Project maintainers have the right and responsibility to remove, edit,
 or reject comments, commits, code, wiki edits, issues, and other
-contributions that are not aligned to this Code of Conduct. Project
+contributions that are not aligned with this Code of Conduct. Project
 maintainers who do not follow the Code of Conduct may be removed from
 the project team.
 
-This code of conduct applies both within project spaces and in public
+This Code of Conduct applies both within project spaces and in public
 spaces when an individual is representing the project or its
 community.
 
@@ -145,12 +167,11 @@ may be reported by opening an issue or contacting one or more of the
 project maintainers.
 
 This Code of Conduct is adapted from the Contributor Covenant, version
-1.1.0, available from http://contributor-covenant.org/version/1/1/0/
+1.1.0, available from [http://contributor-covenant.org/version/1/1/0/](http://contributor-covenant.org/version/1/1/0/)
 
+## Developer's Certificate of Origin (DCO)
 
-## Developer's Certificate of Origin (DCO) ##
-
-By submitting code you are agree and can certify the below:
+By submitting code you agree to and can certify the following:
 
     Developer's Certificate of Origin 1.1
 
@@ -178,13 +199,15 @@ By submitting code you are agree and can certify the below:
         maintained indefinitely and may be redistributed consistent with
         this project or the open source license(s) involved.
 
-Then, all your code patches (**documentation are excluded**) should
+Then, all your code patches (**documentation is excluded**) should
 contain a sign-off at the end of the patch/commit description body. It
-can be automatically added on adding `-s` parameter to `git commit`.
+can be automatically added by adding the `-s` parameter to `git commit`.
 
-This is an example of the aspect of the line:
+This is an example of what the line should look like:
 
-	Signed-off-by: Andrey Antukh <niwi@niwi.nz>
+```
+Signed-off-by: Andrey Antukh <niwi@niwi.nz>
+```
 
 Please, use your real name (sorry, no pseudonyms or anonymous
 contributions are allowed).

README.md

@@ -34,7 +34,7 @@
 
 <br />
 
-[Penpot video](https://github.com/penpot/penpot/assets/5446186/b8ad0764-585e-4ddc-b098-9b4090d337cc)
+[Penpot video](https://github.com/user-attachments/assets/08b83119-c090-4a74-86ed-7bfbdda9a793)
 
 <br />
 
@@ -93,10 +93,9 @@ With Penpot’s standardized [design tokens](https://penpot.dev/collaboration/de
 
 ## Getting started ##
 
-### Install with Elestio ###
-Penpot is the only design & prototype platform that is deployment agnostic. You can use it or deploy it anywhere.
+Penpot is the only design & prototype platform that is deployment agnostic. You can use it in our [SAAS](https://design.penpot.app) or deploy it anywhere.
 
-Learn how to install it with Elestio and Docker, or other options on [our website](https://penpot.app/self-host).
+Learn how to install it with Docker, Kubernetes, Elestio or other options on [our website](https://penpot.app/self-host).
 <br />
 
 <p align="center">
@@ -128,6 +127,12 @@ You will find the following categories:
 </p>
 <br />
 
+### Code of Conduct ###
+
+Anyone who contributes to Penpot, whether through code, in the community, or at an event, must adhere to the
+[code of conduct](https://help.penpot.app/contributing-guide/coc/) and foster a positive and safe environment.
+
+
 ## Contributing ##
 
 Any contribution will make a difference to improve Penpot. How can you get involved?

backend/deps.edn

@@ -6,7 +6,7 @@
   org.clojure/clojure {:mvn/version "1.12.0"}
   org.clojure/tools.namespace {:mvn/version "1.5.0"}
 
-  com.github.luben/zstd-jni {:mvn/version "1.5.6-9"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.7-3"}
 
   io.prometheus/simpleclient {:mvn/version "0.16.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
@@ -17,7 +17,7 @@
 
   io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.5.2.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.6.0.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/yetti
@@ -27,15 +27,15 @@
    :exclusions [org.slf4j/slf4j-api]}
 
   com.github.seancorfield/next.jdbc
-  {:mvn/version "1.3.994"}
-  metosin/reitit-core {:mvn/version "0.7.2"}
+  {:mvn/version "1.3.1002"}
+  metosin/reitit-core {:mvn/version "0.8.0"}
   nrepl/nrepl {:mvn/version "1.3.1"}
-  cider/cider-nrepl {:mvn/version "0.52.0"}
+  cider/cider-nrepl {:mvn/version "0.55.7"}
 
   org.postgresql/postgresql {:mvn/version "42.7.5"}
-  org.xerial/sqlite-jdbc {:mvn/version "3.48.0.0"}
+  org.xerial/sqlite-jdbc {:mvn/version "3.49.1.0"}
 
-  com.zaxxer/HikariCP {:mvn/version "6.2.1"}
+  com.zaxxer/HikariCP {:mvn/version "6.3.0"}
 
   io.whitfin/siphash {:mvn/version "2.0.0"}
 
@@ -44,7 +44,7 @@
 
   com.github.ben-manes.caffeine/caffeine {:mvn/version "3.2.0"}
 
-  org.jsoup/jsoup {:mvn/version "1.18.3"}
+  org.jsoup/jsoup {:mvn/version "1.20.1"}
   org.im4java/im4java
   {:git/tag "1.4.0-penpot-2"
    :git/sha "e2b3e16"
@@ -55,11 +55,11 @@
   org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
 
   dawran6/emoji {:mvn/version "0.1.5"}
-  markdown-clj/markdown-clj {:mvn/version "1.12.2"}
+  markdown-clj/markdown-clj {:mvn/version "1.12.3"}
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.28.26"}}
+  software.amazon.awssdk/s3 {:mvn/version "2.31.48"}}
 
  :paths ["src" "resources" "target/classes"]
  :aliases
@@ -74,7 +74,7 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.10.6" :git/sha "52cf7d6"}}
+   {io.github.clojure/tools.build {:git/tag "v0.10.9" :git/sha "e405aac"}}
    :ns-default build}
 
   :test

backend/package.json

@@ -4,7 +4,7 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.8.1+sha512.bc946f2a022d7a1a38adfc15b36a66a3807a67629789496c3714dd1703d2e6c6b1c69ff9ec3b43141ac7a1dd853b7685638eb0074300386a59c18df351ef8ff6",
+  "packageManager": "yarn@4.9.1+sha512.f95ce356460e05be48d66401c1ae64ef84d163dd689964962c6888a9810865e39097a5e9de748876c2e0bf89b232d583c33982773e9903ae7a76257270986538",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"

backend/scripts/repl

@@ -31,8 +31,8 @@ export PENPOT_FLAGS="\
        enable-tiered-file-data-storage \
        enable-file-validation \
        enable-file-schema-validation \
-       enable-subscriptons \
-       enable-subscriptons-old";
+       enable-subscriptions \
+       enable-subscriptions-old";
 
 # Default deletion delay for devenv
 export PENPOT_DELETION_DELAY="24h"

backend/scripts/start-dev

@@ -24,8 +24,8 @@ export PENPOT_FLAGS="\
        enable-tiered-file-data-storage \
        enable-file-validation \
        enable-file-schema-validation \
-       enable-subscriptons \
-       enable-subscriptons-old ";
+       enable-subscriptions \
+       enable-subscriptions-old ";
 
 # Default deletion delay for devenv
 export PENPOT_DELETION_DELAY="24h"

backend/src/app/binfile/common.clj

@@ -53,6 +53,7 @@
   (* 1024 1024 100))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(declare get-resolved-file-libraries)
 
 (def file-attrs
   #{:id
@@ -143,11 +144,13 @@
    (reduce #(index-object %1 %2 attr) index coll)))
 
 (defn decode-row
-  "A generic decode row helper"
-  [{:keys [data features] :as row}]
-  (cond-> row
-    features (assoc :features (db/decode-pgarray features #{}))
-    data     (assoc :data (blob/decode data))))
+  [{:keys [data changes features] :as row}]
+  (when row
+    (cond-> row
+      features (assoc :features (db/decode-pgarray features #{}))
+      changes  (assoc :changes (blob/decode changes))
+      data     (assoc :data (blob/decode data)))))
+
 
 (defn decode-file
   "A general purpose file decoding function that resolves all external
@@ -156,7 +159,8 @@
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
     (let [file (->> file
                     (feat.fmigr/resolve-applied-migrations cfg)
-                    (feat.fdata/resolve-file-data cfg))]
+                    (feat.fdata/resolve-file-data cfg))
+          libs (delay (get-resolved-file-libraries cfg file))]
 
       (-> file
           (update :features db/decode-pgarray #{})
@@ -164,7 +168,7 @@
           (update :data feat.fdata/process-pointers deref)
           (update :data feat.fdata/process-objects (partial into {}))
           (update :data assoc :id id)
-          (fmg/migrate-file)))))
+          (fmg/migrate-file libs)))))
 
 (defn get-file
   "Get file, resolve all features and apply migrations.
@@ -418,26 +422,27 @@
     (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
 
 (defn process-file
-  [{:keys [id] :as file}]
-  (-> file
-      (update :data (fn [fdata]
-                      (-> fdata
-                          (assoc :id id)
-                          (dissoc :recent-colors))))
-      (fmg/migrate-file)
-      (update :data (fn [fdata]
-                      (-> fdata
-                          (update :pages-index relink-shapes)
-                          (update :components relink-shapes)
-                          (update :media relink-media)
-                          (update :colors relink-colors)
-                          (d/without-nils))))
+  [cfg {:keys [id] :as file}]
+  (let [libs (delay (get-resolved-file-libraries cfg file))]
+    (-> file
+        (update :data (fn [fdata]
+                        (-> fdata
+                            (assoc :id id)
+                            (dissoc :recent-colors))))
+        (update :data (fn [fdata]
+                        (-> fdata
+                            (update :pages-index relink-shapes)
+                            (update :components relink-shapes)
+                            (update :media relink-media)
+                            (update :colors relink-colors)
+                            (d/without-nils))))
+        (fmg/migrate-file libs)
 
-      ;; NOTE: this is necessary because when we just creating a new
-      ;; file from imported artifact or cloned file there are no
-      ;; migrations registered on the database, so we need to persist
-      ;; all of them, not only the applied
-      (vary-meta dissoc ::fmg/migrated)))
+        ;; NOTE: this is necessary because when we just creating a new
+        ;; file from imported artifact or cloned file there are no
+        ;; migrations registered on the database, so we need to persist
+        ;; all of them, not only the applied
+        (vary-meta dissoc ::fmg/migrated))))
 
 (defn encode-file
   [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
@@ -528,3 +533,49 @@
           (l/error :hint "file schema validation error" :cause result))))
 
     (insert-file! cfg file opts)))
+
+
+(def ^:private sql:get-file-libraries
+  "WITH RECURSIVE libs AS (
+     SELECT fl.*, flr.synced_at
+       FROM file AS fl
+       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
+      WHERE flr.file_id = ?::uuid
+    UNION
+     SELECT fl.*, flr.synced_at
+       FROM file AS fl
+       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
+       JOIN libs AS l ON (flr.file_id = l.id)
+   )
+   SELECT l.id,
+          l.features,
+          l.project_id,
+          p.team_id,
+          l.created_at,
+          l.modified_at,
+          l.deleted_at,
+          l.name,
+          l.revn,
+          l.vern,
+          l.synced_at,
+          l.is_shared
+     FROM libs AS l
+    INNER JOIN project AS p ON (p.id = l.project_id)
+    WHERE l.deleted_at IS NULL OR l.deleted_at > now();")
+
+(defn get-file-libraries
+  [conn file-id]
+  (into []
+        (comp
+         ;; FIXME: :is-indirect set to false to all rows looks
+         ;; completly useless
+         (map #(assoc % :is-indirect false))
+         (map decode-row))
+        (db/exec! conn [sql:get-file-libraries file-id])))
+
+(defn get-resolved-file-libraries
+  "A helper for preload file libraries"
+  [{:keys [::db/conn] :as cfg} file]
+  (->> (get-file-libraries conn (:id file))
+       (into [file] (map #(get-file cfg (:id %))))
+       (d/index-by :id)))

backend/src/app/binfile/migrations.clj

@@ -10,7 +10,6 @@
    [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]))
 
@@ -28,13 +27,11 @@
 
 (defn apply-pending-migrations!
   "Apply alredy registered pending migrations to files"
-  [cfg]
-  (doseq [[feature file-id] (-> bfc/*state* deref :pending-to-migrate)]
+  [_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)
+      nil
 
       "fdata/shape-data-type"
       nil

backend/src/app/binfile/v1.clj

@@ -551,8 +551,8 @@
                      (cond-> (and (= idx 0) (some? name))
                        (assoc :name name))
                      (assoc :project-id project-id)
-                     (dissoc :thumbnails)
-                     (bfc/process-file))]
+                     (dissoc :thumbnails))
+            file  (bfc/process-file system file)]
 
         ;; All features that are enabled and requires explicit migration are
         ;; added to the state for a posterior migration step.

backend/src/app/binfile/v2.clj

@@ -281,8 +281,8 @@
 
   (let [file (-> (read-obj cfg :file file-id)
                  (update :id bfc/lookup-index)
-                 (update :project-id bfc/lookup-index)
-                 (bfc/process-file))]
+                 (update :project-id bfc/lookup-index))
+        file (bfc/process-file cfg file)]
 
     (events/tap :progress
                 {:op :import

backend/src/app/binfile/v3.clj

@@ -18,6 +18,7 @@
    [app.common.files.migrations :as-alias fmg]
    [app.common.json :as json]
    [app.common.logging :as l]
+   [app.common.media :as cmedia]
    [app.common.schema :as sm]
    [app.common.thumbnails :as cth]
    [app.common.types.color :as ctcl]
@@ -73,7 +74,7 @@
    [:size ::sm/int]
    [:content-type :string]
    [:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
-   [:hash :string]])
+   [:hash {:optional true} :string]])
 
 (def ^:private schema:file-thumbnail
   [:map {:title "FileThumbnail"}
@@ -88,13 +89,19 @@
    ctf/schema:file
    [:map [:options {:optional true} ctf/schema:options]]])
 
+;; --- HELPERS
+
+(defn- default-now
+  [o]
+  (or o (dt/now)))
+
 ;; --- ENCODERS
 
 (def encode-file
   (sm/encoder schema:file sm/json-transformer))
 
 (def encode-page
-  (sm/encoder ::ctp/page sm/json-transformer))
+  (sm/encoder ctp/schema:page sm/json-transformer))
 
 (def encode-shape
   (sm/encoder ::cts/shape sm/json-transformer))
@@ -129,7 +136,7 @@
   (sm/decoder schema:manifest sm/json-transformer))
 
 (def decode-media
-  (sm/decoder ::ctf/media sm/json-transformer))
+  (sm/decoder ctf/schema:media sm/json-transformer))
 
 (def decode-component
   (sm/decoder ::ctc/component sm/json-transformer))
@@ -229,27 +236,13 @@
                         :always
                         (bfc/clean-file-features))))))
 
-(defn- resolve-extension
-  [mtype]
-  (case mtype
-    "image/png"     ".png"
-    "image/jpeg"    ".jpg"
-    "image/gif"     ".gif"
-    "image/svg+xml" ".svg"
-    "image/webp"    ".webp"
-    "font/woff"     ".woff"
-    "font/woff2"    ".woff2"
-    "font/ttf"      ".ttf"
-    "font/otf"      ".otf"
-    "application/octet-stream" ".bin"))
-
 (defn- export-storage-objects
   [{:keys [::output] :as cfg}]
   (let [storage (sto/resolve cfg)]
     (doseq [id (-> bfc/*state* deref :storage-objects not-empty)]
       (let [sobject (sto/get-object storage id)
             smeta   (meta sobject)
-            ext     (resolve-extension (:content-type smeta))
+            ext     (cmedia/mtype->extension (:content-type smeta))
             path    (str "objects/" id ".json")
             params  (-> (meta sobject)
                         (assoc :id (:id sobject))
@@ -574,7 +567,13 @@
                  (let [object (->> (read-entry input entry)
                                    (decode-media)
                                    (validate-media))
-                       object (assoc object :file-id file-id)]
+                       object (-> object
+                                  (assoc :file-id file-id)
+                                  (update :created-at default-now)
+                                  ;; FIXME: this is set default to true for
+                                  ;; setting a value, this prop is no longer
+                                  ;; relevant;
+                                  (assoc :is-local true))]
                    (if (= id (:id object))
                      (conj result object)
                      result)))
@@ -755,8 +754,9 @@
                    (assoc :data data)
                    (assoc :name file-name)
                    (assoc :project-id project-id)
-                   (dissoc :options)
-                   (bfc/process-file))]
+                   (dissoc :options))
+
+          file  (bfc/process-file cfg file)]
 
       (bfm/register-pending-migrations! cfg file)
       (bfc/save-file! cfg file ::db/return-keys false)
@@ -800,7 +800,7 @@
                     :expected-id (str id)
                     :found-id (str (:id object))))
 
-        (let [ext     (resolve-extension (:content-type object))
+        (let [ext     (cmedia/mtype->extension (:content-type object))
               path    (str "objects/" id ext)
               content (->> path
                            (get-zip-entry input)
@@ -814,13 +814,14 @@
                       :expected-size (:size object)
                       :found-size (sto/get-size content)))
 
-          (when (not= (:hash object) (sto/get-hash content))
-            (ex/raise :type :validation
-                      :code :inconsistent-penpot-file
-                      :hint "found corrupted storage object: hash does not match"
-                      :path path
-                      :expected-hash (:hash object)
-                      :found-hash (sto/get-hash content)))
+          (when-let [hash (get object :hash)]
+            (when (not= hash (sto/get-hash content))
+              (ex/raise :type :validation
+                        :code :inconsistent-penpot-file
+                        :hint "found corrupted storage object: hash does not match"
+                        :path path
+                        :expected-hash (:hash object)
+                        :found-hash (sto/get-hash content))))
 
           (let [params  (-> object
                             (dissoc :id :size)

backend/src/app/features/logical_deletion.clj

@@ -0,0 +1,31 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.features.logical-deletion
+  "A code related to handle logical deletion mechanism"
+  (:require
+   [app.config :as cf]
+   [app.util.time :as dt]))
+
+(defn get-deletion-delay
+  "Calculate the next deleted-at for a resource (file, team, etc) in function
+  of team settings"
+  [team]
+  (if-let [subscription (get team :subscription)]
+    (cond
+      (and (= (:type subscription) "unlimited")
+           (= (:status subscription) "active"))
+      (dt/duration {:days 30})
+
+      (and (= (:type subscription) "enterprise")
+           (= (:status subscription) "active"))
+      (dt/duration {:days 90})
+
+      :else
+      (cf/get-deletion-delay))
+
+    (cf/get-deletion-delay)))
+

backend/src/app/http/sse.clj

@@ -9,7 +9,6 @@
   (:refer-clojure :exclude [tap])
   (:require
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.http.errors :as errors]
@@ -54,18 +53,20 @@
      ::yres/status 200
      ::yres/body (yres/stream-body
                   (fn [_ output]
-                    (binding [events/*channel* (sp/chan :buf buf :xf (keep encode))]
-                      (let [listener (events/start-listener
-                                      (partial write! output)
-                                      (partial pu/close! output))]
-                        (try
+                    (let [channel  (sp/chan :buf buf :xf (keep encode))
+                          listener (events/start-listener
+                                    channel
+                                    (partial write! output)
+                                    (partial pu/close! output))]
+                      (try
+                        (binding [events/*channel* channel]
                           (let [result (handler)]
-                            (events/tap :end result))
-                          (catch Throwable cause
-                            (events/tap :error (errors/handle' cause request))
-                            (when-not (ex/instance? java.io.EOFException cause)
-                              (binding [l/*context* (errors/request->context request)]
-                                (l/err :hint "unexpected error on processing sse response" :cause cause))))
-                          (finally
-                            (sp/close! events/*channel*)
-                            (px/await! listener)))))))}))
+                            (events/tap :end result)))
+
+                        (catch Throwable cause
+                          (let [result (errors/handle' cause request)]
+                            (events/tap channel :error result)))
+
+                        (finally
+                          (sp/close! channel)
+                          (px/await! listener))))))}))

backend/src/app/media.clj

@@ -8,12 +8,11 @@
   "Media & Font postprocessing."
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
    [app.common.schema :as sm]
    [app.common.schema.openapi :as-alias oapi]
-   [app.common.spec :as us]
-   [app.common.svg :as csvg]
    [app.config :as cf]
    [app.db :as-alias db]
    [app.storage :as-alias sto]
@@ -22,39 +21,38 @@
    [buddy.core.bytes :as bb]
    [buddy.core.codecs :as bc]
    [clojure.java.shell :as sh]
-   [clojure.spec.alpha :as s]
+   [clojure.xml :as xml]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [datoteka.io :as io])
   (:import
+   clojure.lang.XMLHandler
+   java.io.InputStream
+   javax.xml.XMLConstants
+   javax.xml.parsers.SAXParserFactory
+   org.apache.commons.io.IOUtils
    org.im4java.core.ConvertCmd
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-(s/def ::path fs/path?)
-(s/def ::filename string?)
-(s/def ::size integer?)
-(s/def ::headers (s/map-of string? string?))
-(s/def ::mtype string?)
+(def schema:upload
+  (sm/register!
+   ^{::sm/type ::upload}
+   [:map {:title "Upload"}
+    [:filename :string]
+    [:size ::sm/int]
+    [:path ::fs/path]
+    [:mtype {:optional true} :string]
+    [:headers {:optional true}
+     [:map-of :string :string]]]))
 
-(s/def ::upload
-  (s/keys :req-un [::filename ::size ::path]
-          :opt-un [::mtype ::headers]))
+(def ^:private schema:input
+  [:map {:title "Input"}
+   [:path ::fs/path]
+   [:mtype {:optional true} ::sm/text]])
 
-;; A subset of fields from the ::upload spec
-(s/def ::input
-  (s/keys :req-un [::path]
-          :opt-un [::mtype]))
-
-(sm/register!
- ^{::sm/type ::upload}
- [:map {:title "Upload"}
-  [:filename :string]
-  [:size ::sm/int]
-  [:path ::fs/path]
-  [:mtype {:optional true} :string]
-  [:headers {:optional true}
-   [:map-of :string :string]]])
+(def ^:private check-input
+  (sm/check-fn schema:input))
 
 (defn validate-media-type!
   ([upload] (validate-media-type! upload cm/valid-image-types))
@@ -97,17 +95,44 @@
     (catch Throwable e
       (process-error e))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SVG PARSING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- secure-parser-factory
+  [^InputStream input ^XMLHandler handler]
+  (.. (doto (SAXParserFactory/newInstance)
+        (.setFeature XMLConstants/FEATURE_SECURE_PROCESSING true)
+        (.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true))
+      (newSAXParser)
+      (parse input handler)))
+
+(defn- strip-doctype
+  [data]
+  (cond-> data
+    (str/includes? data "<!DOCTYPE")
+    (str/replace #"<\!DOCTYPE[^>]*>" "")))
+
+(defn- parse-svg
+  [text]
+  (let [text (strip-doctype text)]
+    (dm/with-open [istream (IOUtils/toInputStream text "UTF-8")]
+      (xml/parse istream secure-parser-factory))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; IMAGE THUMBNAILS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::width integer?)
-(s/def ::height integer?)
-(s/def ::format #{:jpeg :webp :png})
-(s/def ::quality #(< 0 % 101))
+(def ^:private schema:thumbnail-params
+  [:map {:title "ThumbnailParams"}
+   [:input schema:input]
+   [:format [:enum :jpeg :webp :png]]
+   [:quality [:int {:min 1 :max 100}]]
+   [:width :int]
+   [:height :int]])
 
-(s/def ::thumbnail-params
-  (s/keys :req-un [::input ::format ::width ::height]))
+(def ^:private check-thumbnail-params
+  (sm/check-fn schema:thumbnail-params))
 
 ;; Related info on how thumbnails generation
 ;;  http://www.imagemagick.org/Usage/thumbnails/
@@ -129,30 +154,38 @@
            :data   tmp)))
 
 (defmethod process :generic-thumbnail
-  [{:keys [quality width height] :as params}]
-  (us/assert ::thumbnail-params params)
-  (let [op (doto (IMOperation.)
-             (.addImage)
-             (.autoOrient)
-             (.strip)
-             (.thumbnail ^Integer (int width) ^Integer (int height) ">")
-             (.quality (double quality))
-             (.addImage))]
-    (generic-process (assoc params :operation op))))
+  [params]
+  (let [{:keys [quality width height] :as params}
+        (check-thumbnail-params params)
+
+        operation
+        (doto (IMOperation.)
+          (.addImage)
+          (.autoOrient)
+          (.strip)
+          (.thumbnail ^Integer (int width) ^Integer (int height) ">")
+          (.quality (double quality))
+          (.addImage))]
+
+    (generic-process (assoc params :operation operation))))
 
 (defmethod process :profile-thumbnail
-  [{:keys [quality width height] :as params}]
-  (us/assert ::thumbnail-params params)
-  (let [op (doto (IMOperation.)
-             (.addImage)
-             (.autoOrient)
-             (.strip)
-             (.thumbnail ^Integer (int width) ^Integer (int height) "^")
-             (.gravity "center")
-             (.extent (int width) (int height))
-             (.quality (double quality))
-             (.addImage))]
-    (generic-process (assoc params :operation op))))
+  [params]
+  (let [{:keys [quality width height] :as params}
+        (check-thumbnail-params params)
+
+        operation
+        (doto (IMOperation.)
+          (.addImage)
+          (.autoOrient)
+          (.strip)
+          (.thumbnail ^Integer (int width) ^Integer (int height) "^")
+          (.gravity "center")
+          (.extent (int width) (int height))
+          (.quality (double quality))
+          (.addImage))]
+
+    (generic-process (assoc params :operation operation))))
 
 (defn get-basic-info-from-svg
   [{:keys [tag attrs] :as data}]
@@ -184,10 +217,9 @@
 
 (defmethod process :info
   [{:keys [input] :as params}]
-  (us/assert ::input input)
-  (let [{:keys [path mtype]} input]
+  (let [{:keys [path mtype] :as input} (check-input input)]
     (if (= mtype "image/svg+xml")
-      (let [info (some-> path slurp csvg/parse get-basic-info-from-svg)]
+      (let [info (some-> path slurp parse-svg get-basic-info-from-svg)]
         (when-not info
           (ex/raise :type :validation
                     :code :invalid-svg-file

backend/src/app/rpc/commands/audit.clj

@@ -92,9 +92,9 @@
      [:string {:max 250}]
      [::sm/one-of {:format "string"} valid-event-types]]]
    [:props
-    [:map-of :keyword :any]]
+    [:map-of :keyword ::sm/any]]
    [:context {:optional true}
-    [:map-of :keyword :any]]])
+    [:map-of :keyword ::sm/any]]])
 
 (def schema:push-audit-events
   [:map {:title "push-audit-events"}

backend/src/app/rpc/commands/binfile.clj

@@ -115,7 +115,8 @@
 
     (db/update! pool :project
                 {:modified-at (dt/now)}
-                {:id project-id})
+                {:id project-id}
+                {::db/return-keys false})
 
     result))
 

backend/src/app/rpc/commands/files.clj

@@ -6,6 +6,7 @@
 
 (ns app.rpc.commands.files
   (:require
+   [app.binfile.common :as bfc]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
@@ -23,6 +24,7 @@
    [app.db.sql :as-alias sql]
    [app.features.fdata :as feat.fdata]
    [app.features.file-migrations :as feat.fmigr]
+   [app.features.logical-deletion :as ldel]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
@@ -189,7 +191,7 @@
    [:is-shared ::sm/boolean]
    [:project-id ::sm/uuid]
    [:created-at ::dt/instant]
-   [:data {:optional true} :any]])
+   [:data {:optional true} ::sm/any]])
 
 (def schema:permissions-mixin
   [:map {:title "PermissionsMixin"}
@@ -211,7 +213,8 @@
   [{:keys [::db/conn] :as cfg} {:keys [id] :as file} {:keys [read-only?]}]
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
             pmap/*tracked* (pmap/create-tracked)]
-    (let [;; For avoid unnecesary overhead of creating multiple pointers and
+    (let [libs (delay (bfc/get-resolved-file-libraries cfg file))
+          ;; For avoid unnecesary overhead of creating multiple pointers and
           ;; handly internally with objects map in their worst case (when
           ;; probably all shapes and all pointers will be readed in any
           ;; case), we just realize/resolve them before applying the
@@ -219,7 +222,7 @@
           file (-> file
                    (update :data feat.fdata/process-pointers deref)
                    (update :data feat.fdata/process-objects (partial into {}))
-                   (fmg/migrate-file))]
+                   (fmg/migrate-file libs))]
 
       (if (or read-only? (db/read-only? conn))
         file
@@ -615,44 +618,6 @@
 
 ;; --- COMMAND QUERY: get-file-libraries
 
-(def ^:private sql:get-file-libraries
-  "WITH RECURSIVE libs AS (
-     SELECT fl.*, flr.synced_at
-       FROM file AS fl
-       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
-      WHERE flr.file_id = ?::uuid
-    UNION
-     SELECT fl.*, flr.synced_at
-       FROM file AS fl
-       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
-       JOIN libs AS l ON (flr.file_id = l.id)
-   )
-   SELECT l.id,
-          l.features,
-          l.project_id,
-          p.team_id,
-          l.created_at,
-          l.modified_at,
-          l.deleted_at,
-          l.name,
-          l.revn,
-          l.vern,
-          l.synced_at,
-          l.is_shared
-     FROM libs AS l
-    INNER JOIN project AS p ON (p.id = l.project_id)
-    WHERE l.deleted_at IS NULL OR l.deleted_at > now();")
-
-(defn get-file-libraries
-  [conn file-id]
-  (into []
-        (comp
-         ;; FIXME: :is-indirect set to false to all rows looks
-         ;; completly useless
-         (map #(assoc % :is-indirect false))
-         (map decode-row))
-        (db/exec! conn [sql:get-file-libraries file-id])))
-
 (def ^:private schema:get-file-libraries
   [:map {:title "get-file-libraries"}
    [:file-id ::sm/uuid]])
@@ -664,7 +629,7 @@
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
   (dm/with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
-    (get-file-libraries conn file-id)))
+    (bfc/get-file-libraries conn file-id)))
 
 
 ;; --- COMMAND QUERY: Files that use this File library
@@ -970,12 +935,13 @@
 ;; --- MUTATION COMMAND: delete-file
 
 (defn- mark-file-deleted
-  [conn file-id]
-  (let [file (db/update! conn :file
-                         {:deleted-at (dt/now)}
-                         {:id file-id}
-                         {::db/return-keys [:id :name :is-shared :deleted-at
-                                            :project-id :created-at :modified-at]})]
+  [conn team file-id]
+  (let [delay (ldel/get-deletion-delay team)
+        file  (db/update! conn :file
+                          {:deleted-at (dt/in-future delay)}
+                          {:id file-id}
+                          {::db/return-keys [:id :name :is-shared :deleted-at
+                                             :project-id :created-at :modified-at]})]
     (wrk/submit! {::db/conn conn
                   ::wrk/task :delete-object
                   ::wrk/params {:object :file
@@ -991,7 +957,11 @@
 (defn- delete-file
   [{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
   (check-edition-permissions! conn profile-id id)
-  (let [file (mark-file-deleted conn id)]
+  (let [team (teams/get-team conn
+                             :profile-id profile-id
+                             :file-id id)
+        file (mark-file-deleted conn team id)]
+
     (rph/with-meta (rph/wrap)
       {::audit/props {:project-id (:project-id file)
                       :name (:name file)

backend/src/app/rpc/commands/files_temp.clj

@@ -14,7 +14,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 fdata]
    [app.loggers.audit :as audit]
    [app.rpc :as-alias rpc]
@@ -110,7 +109,7 @@
 ;; --- MUTATION COMMAND: persist-temp-file
 
 (defn persist-temp-file
-  [{:keys [::db/conn] :as cfg} {:keys [id ::rpc/profile-id] :as params}]
+  [{:keys [::db/conn] :as cfg} {:keys [id] :as params}]
   (let [file (files/get-file cfg id
                              :migrate? false
                              :lock-for-update? true)]
@@ -119,7 +118,6 @@
       (ex/raise :type :validation
                 :code :cant-persist-already-persisted-file))
 
-
     (let [changes (->> (db/cursor conn
                                   (sql/select :file-change {:file-id id}
                                               {:order-by [[:revn :asc]]})
@@ -147,19 +145,6 @@
                    :revn 1
                    :data (blob/encode (:data file))}
                   {:id id})
-
-      (let [team          (teams/get-team conn :profile-id profile-id :project-id (:project-id file))
-            file-features (:features file)
-            team-features (cfeat/get-team-enabled-features cf/flags team)]
-        (when (and (contains? team-features "components/v2")
-                   (not (contains? file-features "components/v2")))
-          ;; Migrate components v2
-          (feat.compv2/migrate-file! cfg
-                                     (:id file)
-                                     :max-procs 2
-                                     :validate? true
-                                     :throw-on-validate? true)))
-
       nil)))
 
 (def ^:private schema:persist-temp-file

backend/src/app/rpc/commands/files_update.clj

@@ -20,6 +20,7 @@
    [app.db :as db]
    [app.features.fdata :as feat.fdata]
    [app.features.file-migrations :as feat.fmigr]
+   [app.features.logical-deletion :as ldel]
    [app.http.errors :as errors]
    [app.loggers.audit :as audit]
    [app.loggers.webhooks :as webhooks]
@@ -209,7 +210,7 @@
 
   Only intended for internal use on this module."
   [{:keys [::db/conn ::wrk/executor ::timestamp] :as cfg}
-   {:keys [profile-id file features changes session-id skip-validate] :as params}]
+   {:keys [profile-id file team features changes session-id skip-validate] :as params}]
 
   (let [;; Retrieve the file data
         file  (feat.fmigr/resolve-applied-migrations cfg file)
@@ -243,7 +244,7 @@
                    :created-at timestamp
                    :updated-at timestamp
                    :deleted-at (if (::snapshot-data file)
-                                 (dt/plus timestamp (cf/get-deletion-delay))
+                                 (dt/plus timestamp (ldel/get-deletion-delay team))
                                  (dt/plus timestamp (dt/duration {:hours 1})))
                    :file-id (:id file)
                    :revn (:revn file)
@@ -340,6 +341,7 @@
                                     (-> data
                                         (blob/decode)
                                         (assoc :id (:id file)))))
+          libs (delay (bfc/get-resolved-file-libraries cfg file))
 
           ;; For avoid unnecesary overhead of creating multiple pointers
           ;; and handly internally with objects map in their worst
@@ -350,7 +352,7 @@
                  (-> file
                      (update :data feat.fdata/process-pointers deref)
                      (update :data feat.fdata/process-objects (partial into {}))
-                     (fmg/migrate-file))
+                     (fmg/migrate-file libs))
                  file)
 
           file (apply update-fn cfg file args)
@@ -379,13 +381,6 @@
 
       (bfc/encode-file cfg file))))
 
-(defn- get-file-libraries
-  "A helper for preload file libraries, mainly used for perform file
-  semantical and structural validation"
-  [{:keys [::db/conn] :as cfg} file]
-  (->> (files/get-file-libraries conn (:id file))
-       (into [file] (map #(bfc/get-file cfg (:id %))))
-       (d/index-by :id)))
 
 (defn- soft-validate-file-schema!
   [file]
@@ -411,7 +406,7 @@
         (when (and (or (contains? cf/flags :file-validation)
                        (contains? cf/flags :soft-file-validation))
                    (not skip-validate))
-          (get-file-libraries cfg file))
+          (bfc/get-resolved-file-libraries cfg file))
 
 
         ;; The main purpose of this atom is provide a contextual state

backend/src/app/rpc/commands/fonts.clj

@@ -12,6 +12,7 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.db.sql :as-alias sql]
+   [app.features.logical-deletion :as ldel]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
@@ -80,9 +81,9 @@
 (def ^:private schema:create-font-variant
   [:map {:title "create-font-variant"}
    [:team-id ::sm/uuid]
-   [:data [:map-of :string :any]]
+   [:data [:map-of ::sm/text ::sm/any]]
    [:font-id ::sm/uuid]
-   [:font-family :string]
+   [:font-family ::sm/text]
    [:font-weight [::sm/one-of {:format "number"} valid-weight]]
    [:font-style [::sm/one-of {:format "string"} valid-style]]])
 
@@ -202,32 +203,40 @@
 (sv/defmethod ::delete-font
   {::doc/added "1.18"
    ::webhooks/event? true
-   ::sm/params schema:delete-font}
-  [cfg {:keys [::rpc/profile-id id team-id]}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn] :as cfg}]
-                (teams/check-edition-permissions! conn profile-id team-id)
-                (let [fonts   (db/query conn :team-font-variant
-                                        {:team-id team-id
-                                         :font-id id
-                                         :deleted-at nil}
-                                        {::sql/for-update true})
-                      tnow    (dt/now)]
+   ::sm/params schema:delete-font
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id team-id]}]
+  (let [team  (teams/get-team conn
+                              :profile-id profile-id
+                              :team-id team-id)
 
-                  (when-not (seq fonts)
-                    (ex/raise :type :not-found
-                              :code :object-not-found))
+        fonts (db/query conn :team-font-variant
+                        {:team-id team-id
+                         :font-id id
+                         :deleted-at nil}
+                        {::sql/for-update true})
 
-                  (doseq [font fonts]
-                    (db/update! conn :team-font-variant
-                                {:deleted-at tnow}
-                                {:id (:id font)}))
+        delay (ldel/get-deletion-delay team)
+        tnow  (dt/in-future delay)]
 
-                  (rph/with-meta (rph/wrap)
-                    {::audit/props {:id id
-                                    :team-id team-id
-                                    :name (:font-family (peek fonts))
-                                    :profile-id profile-id}})))))
+    (teams/check-edition-permissions! (:permissions team))
+
+    (when-not (seq fonts)
+      (ex/raise :type :not-found
+                :code :object-not-found))
+
+
+    (doseq [font fonts]
+      (db/update! conn :team-font-variant
+                  {:deleted-at tnow}
+                  {:id (:id font)}
+                  {::db/return-keys false}))
+
+    (rph/with-meta (rph/wrap)
+      {::audit/props {:id id
+                      :team-id team-id
+                      :name (:font-family (peek fonts))
+                      :profile-id profile-id}})))
 
 ;; --- DELETE FONT VARIANT
 
@@ -239,19 +248,23 @@
 (sv/defmethod ::delete-font-variant
   {::doc/added "1.18"
    ::webhooks/event? true
-   ::sm/params schema:delete-font-variant}
-  [cfg {:keys [::rpc/profile-id id team-id]}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn] :as cfg}]
-                (teams/check-edition-permissions! conn profile-id team-id)
-                (let [variant (db/get conn :team-font-variant
-                                      {:id id :team-id team-id}
-                                      {::sql/for-update true})]
+   ::sm/params schema:delete-font-variant
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id team-id]}]
+  (let [team    (teams/get-team conn
+                                :profile-id profile-id
+                                :team-id team-id)
+        variant (db/get conn :team-font-variant
+                        {:id id :team-id team-id}
+                        {::sql/for-update true})
+        delay   (ldel/get-deletion-delay team)]
 
-                  (db/update! conn :team-font-variant
-                              {:deleted-at (dt/now)}
-                              {:id (:id variant)})
+    (teams/check-edition-permissions! (:permissions team))
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/in-future delay)}
+                {:id (:id variant)}
+                {::db/return-keys false})
 
-                  (rph/with-meta (rph/wrap)
-                    {::audit/props {:font-family (:font-family variant)
-                                    :font-id (:font-id variant)}})))))
+    (rph/with-meta (rph/wrap)
+      {::audit/props {:font-family (:font-family variant)
+                      :font-id (:font-id variant)}})))

backend/src/app/rpc/commands/management.clj

@@ -56,7 +56,7 @@
     (vswap! bfc/*state* update :index bfc/update-index fmeds :id)
 
     ;; Process and persist file
-    (let [file (bfc/process-file file)]
+    (let [file (bfc/process-file cfg file)]
       (bfc/insert-file! cfg file ::db/return-keys false)
 
       ;; The file profile creation is optional, so when no profile is

backend/src/app/rpc/commands/profile.clj

@@ -480,8 +480,7 @@
         JOIN team AS t ON (t.id = tpr.team_id)
        WHERE tpr.is_owner IS TRUE
          AND tpr.profile_id = ?
-         AND (t.deleted_at IS NULL OR
-              t.deleted_at > now())
+         AND t.deleted_at IS NULL
    )
    SELECT tpr.team_id AS id,
           count(tpr.profile_id) - 1 AS participants

backend/src/app/rpc/commands/projects.clj

@@ -11,6 +11,7 @@
    [app.common.schema :as sm]
    [app.db :as db]
    [app.db.sql :as-alias sql]
+   [app.features.logical-deletion :as ldel]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as webhooks]
    [app.rpc :as-alias rpc]
@@ -253,9 +254,10 @@
 ;; --- MUTATION: Delete Project
 
 (defn- delete-project
-  [conn project-id]
-  (let [project (db/update! conn :project
-                            {:deleted-at (dt/now)}
+  [conn team project-id]
+  (let [delay   (ldel/get-deletion-delay team)
+        project (db/update! conn :project
+                            {:deleted-at (dt/in-future delay)}
                             {:id project-id}
                             {::db/return-keys true})]
 
@@ -272,7 +274,6 @@
 
     project))
 
-
 (def ^:private schema:delete-project
   [:map {:title "delete-project"}
    [:id ::sm/uuid]])
@@ -284,7 +285,10 @@
    ::db/transaction true}
   [{:keys [::db/conn]} {:keys [::rpc/profile-id id] :as params}]
   (check-edition-permissions! conn profile-id id)
-  (let [project (delete-project conn id)]
+  (let [team    (teams/get-team conn
+                                :profile-id profile-id
+                                :project-id id)
+        project (delete-project conn team id)]
     (rph/with-meta (rph/wrap)
       {::audit/props {:team-id (:team-id project)
                       :name (:name project)

backend/src/app/rpc/commands/teams.clj

@@ -17,6 +17,7 @@
    [app.db :as db]
    [app.db.sql :as sql]
    [app.email :as eml]
+   [app.features.logical-deletion :as ldel]
    [app.loggers.audit :as audit]
    [app.main :as-alias main]
    [app.media :as media]
@@ -114,18 +115,6 @@
 
 ;; --- Query: Teams
 
-(declare get-teams)
-
-(def ^:private schema:get-teams
-  [:map {:title "get-teams"}])
-
-(sv/defmethod ::get-teams
-  {::doc/added "1.17"
-   ::sm/params schema:get-teams}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
-  (dm/with-open [conn (db/open pool)]
-    (get-teams conn profile-id)))
-
 (def sql:get-teams-with-permissions
   "SELECT t.*,
           tp.is_owner,
@@ -160,7 +149,7 @@
        ON (tpr.profile_id = p.id)
     WHERE t.deleted_at IS null
       AND tp.profile_id = ?
-    ORDER BY tp.created_at ASC;")
+    ORDER BY tp.created_at ASC")
 
 (defn process-permissions
   [team]
@@ -191,6 +180,37 @@
     (->> (db/exec! conn [sql (:default-team-id profile) profile-id])
          (into [] xform:process-teams))))
 
+(def ^:private schema:get-teams
+  [:map {:title "get-teams"}])
+
+(sv/defmethod ::get-teams
+  {::doc/added "1.17"
+   ::sm/params schema:get-teams}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  (dm/with-open [conn (db/open pool)]
+    (get-teams conn profile-id)))
+
+(def ^:private sql:get-owned-teams
+  "SELECT t.id, t.name,
+          (SELECT count(*) FROM team_profile_rel WHERE team_id=t.id) AS total_members
+     FROM team AS t
+     JOIN team_profile_rel AS tpr ON (tpr.team_id = t.id)
+    WHERE t.is_default IS false
+      AND tpr.is_owner IS true
+      AND tpr.profile_id = ?
+      AND t.deleted_at IS NULL")
+
+(defn- get-owned-teams
+  [cfg profile-id]
+  (->> (db/exec! cfg [sql:get-owned-teams profile-id])
+       (into [] (map decode-row))))
+
+(sv/defmethod ::get-owned-teams
+  {::doc/added "2.8.0"
+   ::sm/params schema:get-teams}
+  [cfg {:keys [::rpc/profile-id]}]
+  (get-owned-teams cfg profile-id))
+
 ;; --- Query: Team (by ID)
 
 (declare get-team)
@@ -214,39 +234,43 @@
 (defn get-team
   [conn & {:keys [profile-id team-id project-id file-id] :as params}]
 
-  (dm/assert!
-   "connection or pool is mandatory"
-   (or (db/connection? conn)
-       (db/pool? conn)))
+  (assert (uuid? profile-id) "profile-id is mandatory")
+  (assert (or (db/connection? conn)
+              (db/pool? conn))
+          "connection or pool is mandatory")
 
-  (dm/assert!
-   "profile-id is mandatory"
-   (uuid? profile-id))
+  (let [{:keys [default-team-id] :as profile}
+        (profile/get-profile conn profile-id)
 
-  (let [{:keys [default-team-id] :as profile} (profile/get-profile conn profile-id)
-        result (cond
-                 (some? team-id)
-                 (let [sql (str "WITH teams AS (" sql:get-teams-with-permissions
-                                ") SELECT * FROM teams WHERE id=?")]
-                   (db/exec-one! conn [sql default-team-id profile-id team-id]))
+        sql
+        (if (contains? cf/flags :subscriptions)
+          sql:get-teams-with-permissions-and-subscription
+          sql:get-teams-with-permissions)
 
-                 (some? project-id)
-                 (let [sql (str "WITH teams AS (" sql:get-teams-with-permissions ") "
-                                "SELECT t.* FROM teams AS t "
-                                "  JOIN project AS p ON (p.team_id = t.id) "
-                                " WHERE p.id=?")]
-                   (db/exec-one! conn [sql default-team-id profile-id project-id]))
+        result
+        (cond
+          (some? team-id)
+          (let [sql (str "WITH teams AS (" sql ") "
+                         "SELECT * FROM teams WHERE id=?")]
+            (db/exec-one! conn [sql default-team-id profile-id team-id]))
 
-                 (some? file-id)
-                 (let [sql (str "WITH teams AS (" sql:get-teams-with-permissions ") "
-                                "SELECT t.* FROM teams AS t "
-                                "  JOIN project AS p ON (p.team_id = t.id) "
-                                "  JOIN file AS f ON (f.project_id = p.id) "
-                                " WHERE f.id=?")]
-                   (db/exec-one! conn [sql default-team-id profile-id file-id]))
+          (some? project-id)
+          (let [sql (str "WITH teams AS (" sql ") "
+                         "SELECT t.* FROM teams AS t "
+                         "  JOIN project AS p ON (p.team_id = t.id) "
+                         " WHERE p.id=?")]
+            (db/exec-one! conn [sql default-team-id profile-id project-id]))
 
-                 :else
-                 (throw (IllegalArgumentException. "invalid arguments")))]
+          (some? file-id)
+          (let [sql (str "WITH teams AS (" sql ") "
+                         "SELECT t.* FROM teams AS t "
+                         "  JOIN project AS p ON (p.team_id = t.id) "
+                         "  JOIN file AS f ON (f.project_id = p.id) "
+                         " WHERE f.id=?")]
+            (db/exec-one! conn [sql default-team-id profile-id file-id]))
+
+          :else
+          (throw (IllegalArgumentException. "invalid arguments")))]
 
     (when-not result
       (ex/raise :type :not-found
@@ -634,13 +658,13 @@
 
 (defn- delete-team
   "Mark a team for deletion"
-  [conn team-id]
+  [conn {:keys [id] :as team}]
 
-  (let [deleted-at (dt/now)
-        team       (db/update! conn :team
-                               {:deleted-at deleted-at}
-                               {:id team-id}
-                               {::db/return-keys true})]
+  (let [delay (ldel/get-deletion-delay team)
+        team  (db/update! conn :team
+                          {:deleted-at (dt/in-future delay)}
+                          {:id id}
+                          {::db/return-keys true})]
 
     (when (:is-default team)
       (ex/raise :type :validation
@@ -650,8 +674,8 @@
     (wrk/submit! {::db/conn conn
                   ::wrk/task :delete-object
                   ::wrk/params {:object :team
-                                :deleted-at deleted-at
-                                :id team-id}})
+                                :deleted-at (:deleted-at team)
+                                :id id}})
     team))
 
 (def ^:private schema:delete-team
@@ -663,12 +687,14 @@
    ::sm/params schema:delete-team
    ::db/transaction true}
   [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id] :as params}]
-  (let [perms (get-permissions conn profile-id id)]
+  (let [team  (get-team conn :profile-id profile-id :team-id id)
+        perms (get team :permissions)]
+
     (when-not (:is-owner perms)
       (ex/raise :type :validation
                 :code :only-owner-can-delete-team))
 
-    (delete-team conn id)
+    (delete-team conn team)
     nil))
 
 ;; --- Mutation: Team Update Role

backend/src/app/rpc/commands/viewer.clj

@@ -6,6 +6,7 @@
 
 (ns app.rpc.commands.viewer
   (:require
+   [app.binfile.common :as bfc]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
    [app.common.schema :as sm]
@@ -78,7 +79,7 @@
                   :always
                   (update :data select-keys [:id :options :pages :pages-index :components]))
 
-        libs    (->> (files/get-file-libraries conn file-id)
+        libs    (->> (bfc/get-file-libraries conn file-id)
                      (mapv (fn [{:keys [id] :as lib}]
                              (merge lib (files/get-file cfg id)))))
 

backend/src/app/rpc/doc.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.json :as json]
    [app.common.pprint :as pp]
    [app.common.schema :as sm]
    [app.common.schema.desc-js-like :as smdj]
@@ -19,7 +20,6 @@
    [app.http.sse :as-alias sse]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
-   [app.util.json :as json]
    [app.util.services :as sv]
    [app.util.template :as tmpl]
    [clojure.java.io :as io]
@@ -86,7 +86,7 @@
     (fn [request]
       (let [params  (:query-params request)
             pstyle  (:type params "js")
-            context (assoc context :param-style pstyle)]
+            context (assoc @context :param-style pstyle)]
 
         {::yres/status 200
          ::yres/body (-> (io/resource "app/templates/api-doc.tmpl")
@@ -178,8 +178,7 @@
     (fn [_]
       {::yres/status 200
        ::yres/headers {"content-type" "application/json; charset=utf-8"}
-       ::yres/body (json/encode context)})
-
+       ::yres/body (json/encode @context)})
     (fn [_]
       {::yres/status 404})))
 
@@ -209,7 +208,7 @@
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::rpc/methods] :as cfg}]
-  [(let [context (prepare-doc-context methods)]
+  [(let [context (delay (prepare-doc-context methods))]
      [["/_doc"
        {:handler (doc-handler context)
         :allowed-methods #{:get}}]
@@ -217,7 +216,7 @@
        {:handler (doc-handler context)
         :allowed-methods #{:get}}]])
 
-   (let [context (prepare-openapi-context methods)]
+   (let [context (delay (prepare-openapi-context methods))]
      [["/openapi"
        {:handler (openapi-handler)
         :allowed-methods #{:get}}]

backend/src/app/srepl/components_v2.clj

@@ -1,306 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.srepl.components-v2
-  (:require
-   [app.common.fressian :as fres]
-   [app.common.logging :as l]
-   [app.db :as db]
-   [app.features.components-v2 :as feat]
-   [app.main :as main]
-   [app.srepl.helpers :as h]
-   [app.util.events :as events]
-   [app.util.time :as dt]
-   [app.worker :as-alias wrk]
-   [datoteka.fs :as fs]
-   [datoteka.io :as io]
-   [promesa.exec :as px]
-   [promesa.exec.semaphore :as ps]
-   [promesa.util :as pu]))
-
-(def ^:dynamic *scope* nil)
-(def ^:dynamic *semaphore* nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; PRIVATE HELPERS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private sql:get-files-by-created-at
-  "SELECT id, features,
-          row_number() OVER (ORDER BY created_at DESC) AS rown
-     FROM file
-    WHERE deleted_at IS NULL
-    ORDER BY created_at DESC")
-
-(defn- get-files
-  [conn]
-  (->> (db/cursor conn [sql:get-files-by-created-at] {:chunk-size 500})
-       (map feat/decode-row)
-       (remove (fn [{:keys [features]}]
-                 (contains? features "components/v2")))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; PUBLIC API
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn migrate-file!
-  [file-id & {:keys [rollback? validate? label cache skip-on-graphic-error?]
-              :or {rollback? true
-                   validate? false
-                   skip-on-graphic-error? true}}]
-  (l/dbg :hint "migrate:start" :rollback rollback?)
-  (let [tpoint  (dt/tpoint)
-        file-id (h/parse-uuid file-id)]
-
-    (binding [feat/*stats* (atom {})
-              feat/*cache* cache]
-      (try
-        (-> (assoc main/system ::db/rollback rollback?)
-            (feat/migrate-file! file-id
-                                :validate? validate?
-                                :skip-on-graphic-error? skip-on-graphic-error?
-                                :label label))
-
-        (-> (deref feat/*stats*)
-            (assoc :elapsed (dt/format-duration (tpoint))))
-
-        (catch Throwable cause
-          (l/wrn :hint "migrate:error" :cause cause))
-
-        (finally
-          (let [elapsed (dt/format-duration (tpoint))]
-            (l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
-
-(defn migrate-team!
-  [team-id & {:keys [rollback? skip-on-graphic-error? validate? label cache]
-              :or {rollback? true
-                   validate? true
-                   skip-on-graphic-error? true}}]
-
-  (l/dbg :hint "migrate:start" :rollback rollback?)
-
-  (let [team-id (h/parse-uuid team-id)
-        stats   (atom {})
-        tpoint  (dt/tpoint)]
-
-    (binding [feat/*stats* stats
-              feat/*cache* cache]
-      (try
-        (-> (assoc main/system ::db/rollback rollback?)
-            (feat/migrate-team! team-id
-                                :label label
-                                :validate? validate?
-                                :skip-on-graphics-error? skip-on-graphic-error?))
-
-        (-> (deref feat/*stats*)
-            (assoc :elapsed (dt/format-duration (tpoint))))
-
-        (catch Throwable cause
-          (l/dbg :hint "migrate:error" :cause cause))
-
-        (finally
-          (let [elapsed (dt/format-duration (tpoint))]
-            (l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
-
-(defn migrate-files!
-  "A REPL helper for migrate all files.
-
-  This function starts multiple concurrent file migration processes
-  until thw maximum number of jobs is reached which by default has the
-  value of `1`. This is controled with the `:max-jobs` option.
-
-  If you want to run this on multiple machines you will need to specify
-  the total number of partitions and the current partition.
-
-  In order to get the report table populated, you will need to provide
-  a correct `:label`. That label is also used for persist a file
-  snaphot before continue with the migration."
-  [& {:keys [max-jobs max-items rollback? validate?
-             cache skip-on-graphic-error?
-             label partitions current-partition]
-      :or {validate? false
-           rollback? true
-           max-jobs 1
-           current-partition 1
-           skip-on-graphic-error? true
-           max-items Long/MAX_VALUE}}]
-
-  (when (int? partitions)
-    (when-not (int? current-partition)
-      (throw (IllegalArgumentException. "missing `current-partition` parameter")))
-    (when-not (<= 0 current-partition partitions)
-      (throw (IllegalArgumentException. "invalid value on `current-partition` parameter"))))
-
-  (let [stats     (atom {})
-        tpoint    (dt/tpoint)
-        factory   (px/thread-factory :virtual false :prefix "penpot/migration/")
-        executor  (px/cached-executor :factory factory)
-
-        sjobs     (ps/create :permits max-jobs)
-
-        migrate-file
-        (fn [file-id rown]
-          (try
-            (db/tx-run! (assoc main/system ::db/rollback rollback?)
-                        (fn [system]
-                          (db/exec-one! system ["SET LOCAL idle_in_transaction_session_timeout = 0"])
-                          (feat/migrate-file! system file-id
-                                              :rown rown
-                                              :label label
-                                              :validate? validate?
-                                              :skip-on-graphic-error? skip-on-graphic-error?)))
-
-            (catch Throwable cause
-              (l/wrn :hint "unexpected error on processing file (skiping)"
-                     :file-id (str file-id))
-
-              (events/tap :error
-                          (ex-info "unexpected error on processing file (skiping)"
-                                   {:file-id file-id}
-                                   cause))
-
-              (swap! stats update :errors (fnil inc 0)))
-
-            (finally
-              (ps/release! sjobs))))
-
-        process-file
-        (fn [{:keys [id rown]}]
-          (ps/acquire! sjobs)
-          (px/run! executor (partial migrate-file id rown)))]
-
-    (l/dbg :hint "migrate:start"
-           :label label
-           :rollback rollback?
-           :max-jobs max-jobs
-           :max-items max-items)
-
-    (binding [feat/*stats* stats
-              feat/*cache* cache]
-      (try
-        (db/tx-run! main/system
-                    (fn [{:keys [::db/conn] :as system}]
-                      (db/exec! conn ["SET LOCAL statement_timeout = 0"])
-                      (db/exec! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
-
-                      (run! process-file
-                            (->> (get-files conn)
-                                 (filter (fn [{:keys [rown] :as row}]
-                                           (if (int? partitions)
-                                             (= current-partition (inc (mod rown partitions)))
-                                             true)))
-                                 (take max-items)))
-
-                      ;; Close and await tasks
-                      (pu/close! executor)))
-
-        (-> (deref stats)
-            (assoc :elapsed (dt/format-duration (tpoint))))
-
-        (catch Throwable cause
-          (l/dbg :hint "migrate:error" :cause cause)
-          (events/tap :error cause))
-
-        (finally
-          (let [elapsed (dt/format-duration (tpoint))]
-            (l/dbg :hint "migrate:end"
-                   :rollback rollback?
-                   :elapsed elapsed)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; CACHE POPULATE
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def sql:sobjects-for-cache
-  "SELECT id,
-          row_number() OVER (ORDER BY created_at) AS index
-     FROM storage_object
-    WHERE (metadata->>'~:bucket' = 'file-media-object' OR
-           metadata->>'~:bucket' IS NULL)
-      AND metadata->>'~:content-type' = 'image/svg+xml'
-      AND deleted_at IS NULL
-      AND size < 1135899
-    ORDER BY created_at ASC")
-
-(defn populate-cache!
-  "A REPL helper for migrate all files.
-
-  This function starts multiple concurrent file migration processes
-  until thw maximum number of jobs is reached which by default has the
-  value of `1`. This is controled with the `:max-jobs` option.
-
-  If you want to run this on multiple machines you will need to specify
-  the total number of partitions and the current partition.
-
-  In order to get the report table populated, you will need to provide
-  a correct `:label`. That label is also used for persist a file
-  snaphot before continue with the migration."
-  [& {:keys [max-jobs] :or {max-jobs 1}}]
-
-  (let [tpoint    (dt/tpoint)
-
-        factory   (px/thread-factory :virtual false :prefix "penpot/cache/")
-        executor  (px/cached-executor :factory factory)
-
-        sjobs     (ps/create :permits max-jobs)
-
-        retrieve-sobject
-        (fn [id index]
-          (let [path   (feat/get-sobject-cache-path id)
-                parent (fs/parent path)]
-
-            (try
-              (when-not (fs/exists? parent)
-                (fs/create-dir parent))
-
-              (if (fs/exists? path)
-                (l/inf :hint "create cache entry" :status "exists" :index index :id (str id) :path (str path))
-                (let [svg-data (feat/get-optimized-svg id)]
-                  (with-open [^java.lang.AutoCloseable stream (io/output-stream path)]
-                    (let [writer (fres/writer stream)]
-                      (fres/write! writer svg-data)))
-
-                  (l/inf :hint "create cache entry" :status "created"
-                         :index index
-                         :id (str id)
-                         :path (str path))))
-
-              (catch Throwable cause
-                (l/wrn :hint "create cache entry"
-                       :status "error"
-                       :index index
-                       :id (str id)
-                       :path (str path)
-                       :cause cause))
-
-              (finally
-                (ps/release! sjobs)))))
-
-        process-sobject
-        (fn [{:keys [id index]}]
-          (ps/acquire! sjobs)
-          (px/run! executor (partial retrieve-sobject id index)))]
-
-    (l/dbg :hint "migrate:start"
-           :max-jobs max-jobs)
-
-    (try
-      (binding [feat/*system* main/system]
-        (run! process-sobject
-              (db/exec! main/system [sql:sobjects-for-cache]))
-
-        ;; Close and await tasks
-        (pu/close! executor))
-
-      {:elapsed (dt/format-duration (tpoint))}
-
-      (catch Throwable cause
-        (l/dbg :hint "populate:error" :cause cause))
-
-      (finally
-        (let [elapsed (dt/format-duration (tpoint))]
-          (l/dbg :hint "populate:end"
-                 :elapsed elapsed))))))

backend/src/app/srepl/helpers.clj

@@ -13,7 +13,6 @@
    [app.common.files.migrations :as fmg]
    [app.common.files.validate :as cfv]
    [app.db :as db]
-   [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]
@@ -62,6 +61,27 @@
                 {:id id})
     team))
 
+(def ^:private sql:get-and-lock-team-files
+  "SELECT f.id
+     FROM file AS f
+     JOIN project AS p ON (p.id = f.project_id)
+    WHERE p.team_id = ?
+      AND p.deleted_at IS NULL
+      AND f.deleted_at IS NULL
+      FOR UPDATE")
+
+(defn get-team
+  [conn team-id]
+  (-> (db/get conn :team {:id team-id}
+              {::db/remove-deleted false
+               ::db/check-deleted false})
+      (update :features db/decode-pgarray #{})))
+
+(defn get-and-lock-team-files
+  [conn team-id]
+  (transduce (map :id) conj []
+             (db/plan conn [sql:get-and-lock-team-files team-id])))
+
 (defn reset-file-data!
   "Hardcode replace of the data of one file."
   [system id data]
@@ -96,7 +116,7 @@
 (defn take-team-snapshot!
   [system team-id label]
   (let [conn (db/get-connection system)]
-    (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+    (->> (get-and-lock-team-files conn team-id)
          (reduce (fn [result file-id]
                    (let [file (fsnap/get-file-snapshots system file-id)]
                      (fsnap/create-file-snapshot! system file
@@ -108,19 +128,16 @@
 (defn restore-team-snapshot!
   [system team-id label]
   (let [conn (db/get-connection system)
-        ids  (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+        ids  (->> (get-and-lock-team-files conn team-id)
                   (into #{}))
 
         snap (search-file-snapshots conn ids label)
 
-        ids' (into #{} (map :file-id) snap)
-        team (-> (feat.comp-v2/get-team conn team-id)
-                 (update :features disj "components/v2"))]
+        ids' (into #{} (map :file-id) snap)]
 
     (when (not= ids ids')
       (throw (RuntimeException. "no uniform snapshot available")))
 
-    (feat.comp-v2/update-team! conn team)
     (reduce (fn [result {:keys [file-id id]}]
               (fsnap/restore-file-snapshot! system file-id id)
               (inc result))
@@ -129,13 +146,9 @@
 
 (defn process-file!
   [system file-id update-fn & {:keys [label validate? with-libraries?] :or {validate? true} :as opts}]
-  (let [conn  (db/get-connection system)
-        file  (bfc/get-file system file-id ::db/for-update true)
+  (let [file  (bfc/get-file system file-id ::db/for-update true)
         libs  (when with-libraries?
-                (->> (files/get-file-libraries conn file-id)
-                     (into [file] (map (fn [{:keys [id]}]
-                                         (bfc/get-file system id))))
-                     (d/index-by :id)))
+                (bfc/get-resolved-file-libraries system file))
 
         file' (when file
                 (if with-libraries?

backend/src/app/srepl/main.clj

@@ -22,7 +22,6 @@
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
-   [app.features.components-v2 :as feat.comp-v2]
    [app.features.fdata :as feat.fdata]
    [app.loggers.audit :as audit]
    [app.main :as main]
@@ -391,12 +390,9 @@
   [file-id]
   (let [file-id (h/parse-uuid file-id)]
     (db/tx-run! (assoc main/system ::db/rollback true)
-                (fn [{:keys [::db/conn] :as system}]
-                  (let [file (h/get-file system file-id)
-                        libs (->> (files/get-file-libraries conn file-id)
-                                  (into [file] (map (fn [{:keys [id]}]
-                                                      (h/get-file system id))))
-                                  (d/index-by :id))]
+                (fn [system]
+                  (let [file (bfc/get-file system file-id)
+                        libs (bfc/get-resolved-file-libraries system file)]
                     (cfv/validate-file file libs))))))
 
 (defn repair-file!
@@ -439,7 +435,7 @@
 
                   (binding [h/*system* system
                             db/*conn* (db/get-connection system)]
-                    (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
+                    (->> (h/get-and-lock-team-files conn team-id)
                          (reduce (fn [result file-id]
                                    (if (h/process-file! system file-id update-fn opts)
                                      (inc result)

backend/src/app/tasks/objects_gc.clj

@@ -9,7 +9,6 @@
   of deleted or unreachable objects."
   (:require
    [app.common.logging :as l]
-   [app.config :as cf]
    [app.db :as db]
    [app.storage :as sto]
    [app.util.time :as dt]
@@ -18,15 +17,15 @@
 (def ^:private sql:get-profiles
   "SELECT id, photo_id FROM profile
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-profiles!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-profiles min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-profiles deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id photo-id]}]
                  (l/trc :hint "permanently delete" :rel "profile" :id (str id))
 
@@ -41,15 +40,15 @@
 (def ^:private sql:get-teams
   "SELECT deleted_at, id, photo_id FROM team
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-teams!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-teams min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-teams deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id photo-id deleted-at]}]
                  (l/trc :hint "permanently delete"
                         :rel "team"
@@ -69,15 +68,15 @@
   "SELECT id, team_id, deleted_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id
      FROM team_font_variant
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-fonts!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-fonts min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-fonts deletion-threshold 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"
@@ -101,15 +100,15 @@
   "SELECT id, deleted_at, team_id
      FROM project
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-projects!
-  [{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-projects min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size] :as cfg}]
+  (->> (db/plan conn [sql:get-projects deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id team-id deleted-at]}]
                  (l/trc :hint "permanently delete"
                         :rel "project"
@@ -127,15 +126,15 @@
   "SELECT id, deleted_at, project_id, data_backend, data_ref_id
      FROM file
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-files!
-  [{:keys [::db/conn ::sto/storage ::min-age ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-files min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::sto/storage ::deletion-threshold ::chunk-size] :as cfg}]
+  (->> (db/plan conn [sql:get-files deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id deleted-at project-id] :as file}]
                  (l/trc :hint "permanently delete"
                         :rel "file"
@@ -156,15 +155,15 @@
   "SELECT file_id, revn, media_id, deleted_at
      FROM file_thumbnail
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn delete-file-thumbnails!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-thumbnails min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-file-thumbnails deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
                  (l/trc :hint "permanently delete"
                         :rel "file-thumbnail"
@@ -185,15 +184,15 @@
   "SELECT file_id, object_id, media_id, deleted_at
      FROM file_tagged_object_thumbnail
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn delete-file-object-thumbnails!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-object-thumbnails min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-file-object-thumbnails deletion-threshold 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"
@@ -214,15 +213,15 @@
   "SELECT file_id, id, deleted_at, data_ref_id
      FROM file_data_fragment
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-data-fragments!
-  [{:keys [::db/conn ::sto/storage ::min-age ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-file-data-fragments min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::sto/storage ::deletion-threshold ::chunk-size] :as cfg}]
+  (->> (db/plan conn [sql:get-file-data-fragments deletion-threshold 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"
@@ -240,15 +239,15 @@
   "SELECT id, file_id, media_id, thumbnail_id, deleted_at
      FROM file_media_object
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-media-objects!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-media-objects min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-file-media-objects deletion-threshold 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"
@@ -269,15 +268,15 @@
   "SELECT id, file_id, deleted_at, data_backend, data_ref_id
      FROM file_change
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() - ?::interval
+      AND deleted_at < now() + ?::interval
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-changes!
-  [{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-change min-age chunk-size] {:fetch-size 5})
+  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  (->> (db/plan conn [sql:get-file-change deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id file-id deleted-at] :as xlog}]
                  (l/trc :hint "permanently delete"
                         :rel "file-change"
@@ -324,16 +323,13 @@
 
 (defmethod ig/expand-key ::handler
   [k v]
-  {k (assoc v
-            ::min-age (cf/get-deletion-delay)
-            ::chunk-size 100)})
+  {k (assoc v ::chunk-size 100)})
 
 (defmethod ig/init-key ::handler
   [_ cfg]
   (fn [{:keys [props] :as task}]
-    (let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
-          cfg     (assoc cfg ::min-age (db/interval min-age))]
-
+    (let [threshold (dt/duration (get props :deletion-threshold 0))
+          cfg       (assoc cfg ::deletion-threshold (db/interval threshold))]
       (loop [procs (map deref deletion-proc-vars)
              total 0]
         (if-let [proc-fn (first procs)]

backend/src/app/util/events.clj

@@ -10,7 +10,6 @@
   to them. Mainly used in http.sse for progress reporting."
   (:refer-clojure :exclude [tap run!])
   (:require
-   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [promesa.exec :as px]
@@ -18,33 +17,30 @@
 
 (def ^:dynamic *channel* nil)
 
-(defn channel
-  []
-  (sp/chan :buf 32))
-
 (defn tap
-  [type data]
-  (when-let [channel *channel*]
-    (sp/put! channel [type data])
-    nil))
+  ([type data]
+   (when-let [channel *channel*]
+     (sp/put! channel [type data])
+     nil))
+  ([channel type data]
+   (when channel
+     (sp/put! channel [type data])
+     nil)))
 
 (defn start-listener
-  [on-event on-close]
-
-  (dm/assert!
-   "expected active events channel"
-   (sp/chan? *channel*))
+  [channel on-event on-close]
+  (assert (sp/chan? channel) "expected active events channel")
 
   (px/thread
     {:virtual true}
     (try
       (loop []
-        (when-let [event (sp/take! *channel*)]
+        (when-let [event (sp/take! channel)]
           (let [result (ex/try! (on-event event))]
             (if (ex/exception? result)
               (do
                 (l/wrn :hint "unexpected exception" :cause result)
-                (sp/close! *channel*))
+                (sp/close! channel))
               (recur)))))
       (finally
         (on-close)))))
@@ -55,7 +51,7 @@
   [f on-event]
 
   (binding [*channel* (sp/chan :buf 32)]
-    (let [listener (start-listener on-event (constantly nil))]
+    (let [listener (start-listener *channel* on-event (constantly nil))]
       (try
         (f)
         (finally

backend/test/backend_tests/helpers.clj

@@ -222,7 +222,7 @@
   ([params]
    (mark-file-deleted* *system* params))
   ([conn {:keys [id] :as params}]
-   (#'files/mark-file-deleted conn id)))
+   (#'files/mark-file-deleted conn {} id)))
 
 (defn create-team*
   ([i params] (create-team* *system* i params))

backend/test/backend_tests/rpc_file_test.clj

@@ -8,10 +8,10 @@
   (:require
    [app.common.features :as cfeat]
    [app.common.pprint :as pp]
-   [app.common.pprint :as pp]
    [app.common.thumbnails :as thc]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http :as http]
@@ -123,8 +123,27 @@
                   :components-v2 true}
             out (th/command! data)]
 
-        ;; (th/print-result! out)
 
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
+
+        (let [result (:result out)]
+          (t/is (some? (:deleted-at result)))
+          (t/is (= file-id (:id result)))
+          (t/is (= "new name" (:name result)))
+          (t/is (= 1 (count (get-in result [:data :pages]))))
+          (t/is (nil? (:users result))))))
+
+    (th/db-update! :file
+                   {:deleted-at (dt/now)}
+                   {:id file-id})
+
+    (t/testing "query single file after delete and wait"
+      (let [data {::th/type :get-file
+                  ::rpc/profile-id (:id prof)
+                  :id file-id
+                  :components-v2 true}
+            out (th/command! data)]
         (let [error      (:error out)
               error-data (ex-data error)]
           (t/is (th/ex-info? error))
@@ -195,7 +214,7 @@
         (t/is (= 5 (count rows))))
 
       ;; The objects-gc should remove unused fragments
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 3 (:processed res))))
 
       ;; Check the number of fragments
@@ -230,7 +249,7 @@
       (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
 
       ;; The objects-gc should remove unused fragments
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 3 (:processed res))))
 
       ;; Check the number of fragments;
@@ -254,7 +273,7 @@
         (t/is (= 4 (count rows)))
         (t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@@ -355,7 +374,7 @@
         (t/is (= 2 (count rows)))
         (t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 3 (:processed res))))
 
       ;; check file media objects
@@ -386,7 +405,7 @@
 
       ;; This only clears fragments, the file media objects still referenced because
       ;; snapshots are preserved
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       ;; Mark all snapshots to be a non-snapshot file change
@@ -395,7 +414,7 @@
 
       ;; Rerun the file-gc and objects-gc
       (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       ;; Now that file-gc have deleted the file-media-object usage,
@@ -508,7 +527,7 @@
       ;; run the task again
       (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
@@ -550,7 +569,7 @@
 
       ;; This only removes unused fragments, file media are still
       ;; referenced on snapshots.
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       ;; Mark all snapshots to be a non-snapshot file change
@@ -560,7 +579,7 @@
       ;; Rerun file-gc and objects-gc task for the same file once all snapshots are
       ;; "expired/deleted"
       (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 6 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
@@ -712,7 +731,7 @@
       ;; Now that file-gc have marked for deletion the object
       ;; thumbnail lets execute the objects-gc task which remove
       ;; the rows and mark as touched the storage object rows
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 5 (:processed res))))
 
       ;; Now that objects-gc have deleted the object thumbnail lets
@@ -741,7 +760,7 @@
         (t/is (= 1 (count rows)))
         (t/is (= 0 (count (remove (comp some? :deleted-at) rows)))))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         ;; (pp/pprint res)
         (t/is (= 3 (:processed res))))
 
@@ -876,7 +895,7 @@
                                      :profile-id (:id profile1)})]
     ;; file is not deleted because it does not meet all
     ;; conditions to be deleted.
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of files
@@ -907,7 +926,7 @@
         (t/is (= 0 (count result)))))
 
     ;; run permanent deletion (should be noop)
-    (let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of file libraries of a after hard deletion
@@ -921,7 +940,7 @@
         (t/is (= 0 (count result)))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 1 (:processed result))))
 
     ;; query the list of file libraries of a after hard deletion
@@ -1176,7 +1195,7 @@
         (t/is (= 2 (count rows)))
         (t/is (= 1 (count (remove :deleted-at rows)))))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 4 (:processed res))))
 
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
@@ -1232,7 +1251,7 @@
         (t/is (= 2 (count rows)))
         (t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
 
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed res))))
 
       (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
@@ -1251,7 +1270,7 @@
     (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
 
       ;; Preventive objects-gc
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 1 (:processed result))))
 
       ;; Check the number of fragments before adding the page
@@ -1272,7 +1291,7 @@
       (th/run-pending-tasks!))
 
       ;; Clean objects after file-gc
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 1 (:processed result))))
 
       ;; Check the number of fragments before adding the page
@@ -1324,7 +1343,7 @@
     (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
 
       ;; The objects-gc should remove unused fragments
-    (let [res (th/run-task! :objects-gc {:min-age 0})]
+    (let [res (th/run-task! :objects-gc {})]
       (t/is (= 2 (:processed res))))
 
       ;; Check the number of fragments before adding the page
@@ -1712,6 +1731,7 @@
         [{:fill-image
           {:id (:id fmedia)
            :name "test"
+           :mtype "image/jpeg"
            :width 200
            :height 200}}]]
 
@@ -1820,8 +1840,7 @@
       (t/is (= (:id file-2) (:file-id (get rows 1))))
       (t/is (nil? (:deleted-at (get rows 1)))))
 
-    (th/run-task! :objects-gc
-                  {:min-age 0})
+    (th/run-task! :objects-gc {})
 
     (let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
       (t/is (= 1 (count rows)))

backend/test/backend_tests/rpc_font_test.clj

@@ -7,6 +7,7 @@
 (ns backend-tests.rpc-font-test
   (:require
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
@@ -144,7 +145,7 @@
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:min-age 0})]
+    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 2 (:processed res))))
 
     (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
@@ -204,7 +205,7 @@
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:min-age 0})]
+    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 1 (:processed res))))
 
     (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
@@ -263,7 +264,7 @@
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:min-age 0})]
+    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 1 (:processed res))))
 
     (let [res (th/run-task! :storage-gc-touched {:min-age 0})]

backend/test/backend_tests/rpc_profile_test.clj

@@ -209,16 +209,16 @@
                     ::rpc/profile-id (:id prof1)
                     :id (:id team1)}
             out    (th/command! params)]
-      ;; (th/print-result! out)
+        ;; (th/print-result! out)
 
         (let [team (th/db-get :team {:id (:id team1)} {::db/remove-deleted false})]
           (t/is (dt/instant? (:deleted-at team)))))
 
-    ;; Request profile to be deleted
+      ;; Request profile to be deleted
       (let [params {::th/type :delete-profile
                     ::rpc/profile-id (:id prof1)}
             out    (th/command! params)]
-      ;; (th/print-result! out)
+        ;; (th/print-result! out)
         (t/is (nil? (:result out)))
         (t/is (nil? (:error out)))))))
 

backend/test/backend_tests/rpc_project_test.clj

@@ -7,6 +7,7 @@
 (ns backend-tests.rpc-project-test
   (:require
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
@@ -178,7 +179,7 @@
 
     ;; project is not deleted because it does not meet all
     ;; conditions to be deleted.
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of projects
@@ -210,7 +211,7 @@
         (t/is (= 1 (count result)))))
 
     ;; run permanent deletion (should be noop)
-    (let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of files of a after soft deletion
@@ -224,7 +225,7 @@
         (t/is (= 0 (count result)))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 1 (:processed result))))
 
     ;; query the list of files of a after hard deletion

backend/test/backend_tests/rpc_team_test.clj

@@ -8,6 +8,7 @@
   (:require
    [app.common.logging :as l]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
@@ -449,6 +450,23 @@
       (t/is (nil? res)))))
 
 
+(t/deftest get-owned-teams
+  (let [profile1 (th/create-profile* 1 {:is-active true})
+        profile2 (th/create-profile* 2 {:is-active true})
+        team1    (th/create-team* 1 {:profile-id (:id profile1)})
+        team2    (th/create-team* 2 {:profile-id (:id profile2)})
+
+        params   {::th/type :get-owned-teams
+                  ::rpc/profile-id (:id profile1)}
+        out      (th/command! params)]
+
+    (t/is (th/success? out))
+    (let [result (:result out)]
+      (t/is (= 1 (count result)))
+      (t/is (= (:id team1) (-> result first :id)))
+      (t/is (not= (:default-team-id profile1) (-> result first :id))))))
+
+
 (t/deftest team-deletion-1
   (let [profile1 (th/create-profile* 1 {:is-active true})
         team     (th/create-team* 1 {:profile-id (:id profile1)})
@@ -459,7 +477,7 @@
 
     ;; team is not deleted because it does not meet all
     ;; conditions to be deleted.
-    (let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of teams
@@ -493,7 +511,7 @@
     (th/run-pending-tasks!)
 
     ;; run permanent deletion (should be noop)
-    (let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
+    (let [result (th/run-task! :objects-gc {})]
       (t/is (= 0 (:processed result))))
 
     ;; query the list of projects after hard deletion
@@ -507,7 +525,7 @@
         (t/is (= :not-found (:type edata)))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
+    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 2 (:processed result))))
 
     ;; query the list of projects of a after hard deletion
@@ -521,7 +539,6 @@
       (let [edata (-> out :error ex-data)]
         (t/is (= :not-found (:type edata)))))))
 
-
 (t/deftest team-deletion-2
   (let [storage (-> (:app.storage/storage th/*system*)
                     (assoc ::sto/backend :assets-fs))
@@ -564,7 +581,7 @@
       (t/is (= 1 (count rows)))
       (t/is (dt/instant? (:deleted-at (first rows)))))
 
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
+    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
       (t/is (= 5 (:processed result))))))
 
 (t/deftest create-team-access-request

common/deps.edn

@@ -12,14 +12,14 @@
   org.apache.logging.log4j/log4j-web {:mvn/version "2.24.3"}
   org.apache.logging.log4j/log4j-jul {:mvn/version "2.24.3"}
   org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.24.3"}
-  org.slf4j/slf4j-api {:mvn/version "2.0.16"}
+  org.slf4j/slf4j-api {:mvn/version "2.0.17"}
   pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
 
-  selmer/selmer {:mvn/version "1.12.61"}
+  selmer/selmer {:mvn/version "1.12.62"}
   criterium/criterium {:mvn/version "0.4.6"}
 
   metosin/jsonista {:mvn/version "0.3.13"}
-  metosin/malli {:mvn/version "0.17.0"}
+  metosin/malli {:mvn/version "0.18.0"}
 
   expound/expound {:mvn/version "0.9.0"}
   com.cognitect/transit-clj {:mvn/version "1.0.333"}
@@ -28,9 +28,9 @@
   integrant/integrant {:mvn/version "0.13.1"}
 
   funcool/tubax {:mvn/version "2021.05.20-0"}
-  funcool/cuerdas {:mvn/version "2023.11.09-407"}
+  funcool/cuerdas {:mvn/version "2025.05.26-411"}
   funcool/promesa
-  {:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
+  {:git/sha "f52f58cfacf62f59eab717e2637f37729d0cc383"
    :git/url "https://github.com/funcool/promesa"}
 
   funcool/datoteka
@@ -59,7 +59,7 @@
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "3.0.3"}
+    thheller/shadow-cljs {:mvn/version "3.0.5"}
     com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}
@@ -68,7 +68,7 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.10.6" :git/sha "52cf7d6"}}
+   {io.github.clojure/tools.build {:git/tag "v0.10.9" :git/sha "e405aac"}}
    :ns-default build}
 
   :test
@@ -76,9 +76,9 @@
    :extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
 
   :shadow-cljs
-  {:main-opts ["-m" "shadow.cljs.devtools.cli"]}
+  {:main-opts ["-m" "shadow.cljs.devtools.cli"]
+   :jvm-opts ["--sun-misc-unsafe-memory-access=allow"]}
 
   :outdated
   {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
    :main-opts ["-m" "antq.core"]}}}
-

common/package.json

@@ -4,20 +4,19 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.8.1+sha512.bc946f2a022d7a1a38adfc15b36a66a3807a67629789496c3714dd1703d2e6c6b1c69ff9ec3b43141ac7a1dd853b7685638eb0074300386a59c18df351ef8ff6",
+  "packageManager": "yarn@4.9.1+sha512.f95ce356460e05be48d66401c1ae64ef84d163dd689964962c6888a9810865e39097a5e9de748876c2e0bf89b232d583c33982773e9903ae7a76257270986538",
   "type": "module",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"
   },
   "dependencies": {
-    "luxon": "^3.4.4",
-    "sax": "^1.4.1"
+    "luxon": "^3.4.4"
   },
   "devDependencies": {
     "concurrently": "^9.0.1",
     "nodemon": "^3.1.7",
-    "shadow-cljs": "3.0.3",
+    "shadow-cljs": "3.0.5",
     "source-map-support": "^0.5.21",
     "ws": "^8.17.0"
   },

common/src/app/common/data.cljc

@@ -33,6 +33,12 @@
 (def boolean-or-nil?
   (some-fn nil? boolean?))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Commonly used transducers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def xf:map-id (map :id))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Data Structures
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/files/builder.cljc

@@ -10,20 +10,21 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.features :as cfeat]
+   [app.common.exceptions :as ex]
    [app.common.files.changes :as ch]
+   ;; [app.common.features :as cfeat]
+   [app.common.files.helpers :as cph]
    [app.common.files.migrations :as fmig]
-   [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
    [app.common.schema :as sm]
    [app.common.svg :as csvg]
+   [app.common.time :as dt]
    [app.common.types.color :as types.color]
-   [app.common.types.component :as types.component]
-   [app.common.types.components-list :as types.components-list]
-   [app.common.types.container :as types.container]
+   [app.common.types.component :as types.comp]
+   [app.common.types.container :as types.cont]
    [app.common.types.file :as types.file]
    [app.common.types.page :as types.page]
-   [app.common.types.pages-list :as types.pages-list]
+   [app.common.types.path :as types.path]
    [app.common.types.shape :as types.shape]
    [app.common.types.typography :as types.typography]
    [app.common.uuid :as uuid]
@@ -37,41 +38,36 @@
 (def ^:private conjv (fnil conj []))
 (def ^:private conjs (fnil conj #{}))
 
-(defn default-uuid
+(defn- default-uuid
   [v]
   (or v (uuid/next)))
 
 (defn- track-used-name
-  [file name]
-  (let [container-id (::current-page-id file)]
-    (update-in file [::unames container-id] conjs name)))
+  [state name]
+  (let [container-id (::current-page-id state)]
+    (update-in state [::unames container-id] conjs name)))
 
 (defn- commit-change
-  [file change & {:keys [add-container]
-                  :or   {add-container false}}]
+  [state change & {:keys [add-container]}]
+  (let [file-id (get state ::current-file-id)]
+    (assert (uuid? file-id) "no current file id")
 
-  (let [change (cond-> change
-                 add-container
-                 (assoc :page-id  (::current-page-id file)
-                        :frame-id (::current-frame-id file)))]
-    (-> file
-        (update ::changes conjv change)
-        (update :data ch/process-changes [change] false))))
-
-(defn- lookup-objects
-  [file]
-  (dm/get-in file [:data :pages-index (::current-page-id file) :objects]))
+    (let [change (cond-> change
+                   add-container
+                   (assoc :page-id  (::current-page-id state)
+                          :frame-id (::current-frame-id state)))]
+      (update-in state [::files file-id :data] ch/process-changes [change] false))))
 
 (defn- commit-shape
-  [file shape]
+  [state shape]
   (let [parent-id
-        (-> file ::parent-stack peek)
+        (-> state ::parent-stack peek)
 
         frame-id
-        (::current-frame-id file)
+        (get state ::current-frame-id)
 
         page-id
-        (::current-page-id file)
+        (get state ::current-page-id)
 
         change
         {:type :add-obj
@@ -82,39 +78,31 @@
          :frame-id frame-id
          :page-id page-id}]
 
-    (-> file
+    (-> state
         (commit-change change)
         (track-used-name (:name shape)))))
 
-(defn- generate-name
-  [type data]
-  (if (= type :svg-raw)
-    (let [tag (dm/get-in data [:content :tag])]
-      (str "svg-" (cond (string? tag) tag
-                        (keyword? tag) (d/name tag)
-                        (nil? tag) "node"
-                        :else (str tag))))
-    (str/capital (d/name type))))
-
 (defn- unique-name
-  [name file]
-  (let [container-id (::current-page-id file)
-        unames (dm/get-in file [:unames container-id])]
+  [name state]
+  (let [container-id (::current-page-id state)
+        unames       (dm/get-in state [:unames container-id])]
     (d/unique-name name (or unames #{}))))
 
 (defn- clear-names [file]
   (dissoc file ::unames))
 
-(defn- assign-name
+(defn- assign-shape-name
   "Given a tag returns its layer name"
-  [data file type]
-
-  (cond-> data
-    (nil? (:name data))
-    (assoc :name (generate-name type data))
+  [shape state]
+  (cond-> shape
+    (nil? (:name shape))
+    (assoc :name (let [type (get shape :type)]
+                   (case type
+                     :frame "Board"
+                     (str/capital (d/name type)))))
 
     :always
-    (update :name unique-name file)))
+    (update :name unique-name state)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMAS
@@ -135,20 +123,21 @@
 (def decode-library-typography
   (sm/decode-fn types.typography/schema:typography sm/json-transformer))
 
-(def decode-component
-  (sm/decode-fn types.component/schema:component sm/json-transformer))
-
-(def schema:add-component-instance
+(def schema:add-component
   [:map
    [:component-id ::sm/uuid]
-   [:x ::sm/safe-number]
-   [:y ::sm/safe-number]])
+   [:file-id {:optional true} ::sm/uuid]
+   [:name {:optional true} ::sm/text]
+   [:path {:optional true} ::sm/text]
+   [:frame-id {:optional true} ::sm/uuid]
+   [:page-id {:optional true} ::sm/uuid]])
 
-(def check-add-component-instance
-  (sm/check-fn schema:add-component-instance))
+(def ^:private check-add-component
+  (sm/check-fn schema:add-component
+               :hint "invalid arguments passed for add-component"))
 
-(def decode-add-component-instance
-  (sm/decode-fn schema:add-component-instance sm/json-transformer))
+(def decode-add-component
+  (sm/decode-fn schema:add-component sm/json-transformer))
 
 (def schema:add-bool
   [:map
@@ -158,37 +147,97 @@
 (def decode-add-bool
   (sm/decode-fn schema:add-bool sm/json-transformer))
 
-(def check-add-bool
+(def ^:private check-add-bool
   (sm/check-fn schema:add-bool))
 
+(def schema:add-file-media
+  [:map
+   [:id {:optional true} ::sm/uuid]
+   [:name ::sm/text]
+   [:width ::sm/int]
+   [:height ::sm/int]])
+
+(def decode-add-file-media
+  (sm/decode-fn schema:add-file-media sm/json-transformer))
+
+(def check-add-file-media
+  (sm/check-fn schema:add-file-media))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn lookup-shape [file shape-id]
-  (-> (lookup-objects file)
-      (get shape-id)))
+(defn create-state
+  []
+  {})
 
 (defn get-current-page
-  [file]
-  (let [page-id (::current-page-id file)]
-    (dm/get-in file [:data :pages-index page-id])))
+  [state]
+  (let [file-id (get state ::current-file-id)
+        page-id (get state ::current-page-id)]
 
-(defn create-file
-  [params]
+    (assert (uuid? file-id) "expected current-file-id to be assigned")
+    (assert (uuid? page-id) "expected current-page-id to be assigned")
+    (dm/get-in state [::files file-id :data :pages-index page-id])))
+
+(defn get-current-objects
+  [state]
+  (-> (get-current-page state)
+      (get :objects)))
+
+(defn get-shape
+  [state shape-id]
+  (-> (get-current-objects state)
+      (get shape-id)))
+
+;; WORKAROUND: A copy of features from staging for make the library
+;; generate files compatible with version released right now. This
+;; should be removed and replaced with cfeat/default-features when 2.8
+;; version is released
+
+(def default-features
+  #{"fdata/shape-data-type"
+    "styles/v2"
+    "layout/grid"
+    "components/v2"
+    "plugins/runtime"
+    "design-tokens/v1"})
+
+;; WORKAROUND: the same as features
+(def available-migrations
+  (-> fmig/available-migrations
+      (disj "003-convert-path-content")
+      (disj "0002-clean-shape-interactions")
+      (disj "0003-fix-root-shape")))
+
+(defn add-file
+  [state params]
   (let [params (-> params
-                   (assoc :features cfeat/default-features)
-                   (assoc :migrations fmig/available-migrations))]
-    (types.file/make-file params :create-page false)))
+                   (assoc :features default-features)
+                   (assoc :migrations available-migrations)
+                   (update :id default-uuid))
+        file   (types.file/make-file params :create-page false)]
+    (-> state
+        (update ::files assoc (:id file) file)
+        (assoc ::current-file-id (:id file)))))
+
+(declare close-page)
+
+(defn close-file
+  [state]
+  (let [state (-> state
+                  (close-page)
+                  (dissoc ::current-file-id))]
+    state))
 
 (defn add-page
-  [file params]
+  [state params]
   (let [page   (-> (types.page/make-empty-page params)
                    (types.page/check-page))
         change {:type :add-page
                 :page page}]
 
-    (-> file
+    (-> state
         (commit-change change)
 
         ;; Current page being edited
@@ -203,215 +252,234 @@
         ;; Last object id added
         (assoc ::last-id nil))))
 
-(defn close-page [file]
-  (-> file
+(defn close-page [state]
+  (-> state
       (dissoc ::current-page-id)
       (dissoc ::parent-stack)
       (dissoc ::last-id)
       (clear-names)))
 
-(defn add-artboard
-  [file data]
+(defn add-board
+  [state params]
   (let [{:keys [id] :as shape}
-        (-> data
+        (-> params
             (update :id default-uuid)
             (assoc :type :frame)
-            (assign-name file :frame)
+            (assign-shape-name state)
             (types.shape/setup-shape)
             (types.shape/check-shape))]
 
-    (-> file
+    (-> state
         (commit-shape shape)
         (update ::parent-stack conjv id)
         (assoc ::current-frame-id id)
         (assoc ::last-id id))))
 
-(defn close-artboard
-  [file]
-  (let [parent-id (-> file ::parent-stack peek)
-        parent    (lookup-shape file parent-id)]
-    (-> file
+(defn close-board
+  [state]
+  (let [parent-id (-> state ::parent-stack peek)
+        parent    (get-shape state parent-id)]
+    (-> state
         (assoc ::current-frame-id (or (:frame-id parent) root-id))
         (update ::parent-stack pop))))
 
 (defn add-group
-  [file params]
+  [state params]
   (let [{:keys [id] :as shape}
         (-> params
             (update :id default-uuid)
             (assoc :type :group)
-            (assign-name file :group)
+            (assign-shape-name state)
             (types.shape/setup-shape)
             (types.shape/check-shape))]
-    (-> file
+    (-> state
         (commit-shape shape)
         (assoc ::last-id id)
         (update ::parent-stack conjv id))))
 
 (defn close-group
-  [file]
-  (let [group-id (-> file :parent-stack peek)
-        group    (lookup-shape file group-id)
+  [state]
+  (let [group-id (-> state ::parent-stack peek)
+        group    (get-shape state group-id)
         children (->> (get group :shapes)
-                      (into [] (keep (partial lookup-shape file)))
+                      (into [] (keep (partial get-shape state)))
                       (not-empty))]
 
     (assert (some? children) "group expect to have at least 1 children")
 
-    (let [file (if (:masked-group group)
-                 (let [mask  (first children)
-                       change {:type :mod-obj
-                               :id group-id
-                               :operations
-                               [{:type :set :attr :x :val (-> mask :selrect :x) :ignore-touched true}
-                                {:type :set :attr :y :val (-> mask :selrect :y) :ignore-touched true}
-                                {:type :set :attr :width :val (-> mask :selrect :width) :ignore-touched true}
-                                {:type :set :attr :height :val (-> mask :selrect :height) :ignore-touched true}
-                                {:type :set :attr :flip-x :val (-> mask :flip-x) :ignore-touched true}
-                                {:type :set :attr :flip-y :val (-> mask :flip-y) :ignore-touched true}
-                                {:type :set :attr :selrect :val (-> mask :selrect) :ignore-touched true}
-                                {:type :set :attr :points :val (-> mask :points) :ignore-touched true}]}]
-                   (commit-change file change :add-container true))
-                 (let [group  (gsh/update-group-selrect group children)
-                       change {:type :mod-obj
-                               :id group-id
-                               :operations
-                               [{:type :set :attr :selrect :val (:selrect group) :ignore-touched true}
-                                {:type :set :attr :points  :val (:points group) :ignore-touched true}
-                                {:type :set :attr :x       :val (-> group :selrect :x) :ignore-touched true}
-                                {:type :set :attr :y       :val (-> group :selrect :y) :ignore-touched true}
-                                {:type :set :attr :width   :val (-> group :selrect :width) :ignore-touched true}
-                                {:type :set :attr :height  :val (-> group :selrect :height) :ignore-touched true}]}]
+    (let [state (if (:masked-group group)
+                  (let [mask  (first children)
+                        change {:type :mod-obj
+                                :id group-id
+                                :operations
+                                [{:type :set :attr :x :val (-> mask :selrect :x) :ignore-touched true}
+                                 {:type :set :attr :y :val (-> mask :selrect :y) :ignore-touched true}
+                                 {:type :set :attr :width :val (-> mask :selrect :width) :ignore-touched true}
+                                 {:type :set :attr :height :val (-> mask :selrect :height) :ignore-touched true}
+                                 {:type :set :attr :flip-x :val (-> mask :flip-x) :ignore-touched true}
+                                 {:type :set :attr :flip-y :val (-> mask :flip-y) :ignore-touched true}
+                                 {:type :set :attr :selrect :val (-> mask :selrect) :ignore-touched true}
+                                 {:type :set :attr :points :val (-> mask :points) :ignore-touched true}]}]
+                    (commit-change state change :add-container true))
+                  (let [group  (gsh/update-group-selrect group children)
+                        change {:type :mod-obj
+                                :id group-id
+                                :operations
+                                [{:type :set :attr :selrect :val (:selrect group) :ignore-touched true}
+                                 {:type :set :attr :points  :val (:points group) :ignore-touched true}
+                                 {:type :set :attr :x       :val (-> group :selrect :x) :ignore-touched true}
+                                 {:type :set :attr :y       :val (-> group :selrect :y) :ignore-touched true}
+                                 {:type :set :attr :width   :val (-> group :selrect :width) :ignore-touched true}
+                                 {:type :set :attr :height  :val (-> group :selrect :height) :ignore-touched true}]}]
 
-                   (commit-change file change :add-container true)))]
-      (update file ::parent-stack pop))))
+                    (commit-change state change :add-container true)))]
+      (update state ::parent-stack pop))))
+
+(defn- update-bool-style-properties
+  [bool-shape objects]
+  (let [xform
+        (comp
+         (map (d/getf objects))
+         (remove cph/frame-shape?)
+         (remove types.comp/is-variant?)
+         (remove (partial types.cont/has-any-copy-parent? objects)))
+
+        children
+        (->> (get bool-shape :shapes)
+             (into [] xform)
+             (not-empty))]
+
+    (when-not children
+      (ex/raise :type :validation
+                :code :empty-children
+                :hint "expected a group with at least one shape for creating a bool"))
+
+    (let [head  (if (= type :difference)
+                  (first children)
+                  (last children))
+          fills (if (and (contains? head :svg-attrs) (empty? (:fills head)))
+                  types.path/default-bool-fills
+                  (get head :fills))]
+      (-> bool-shape
+          (assoc :fills fills)
+          (assoc :stroks (get head :strokes))))))
 
 (defn add-bool
-  [file params]
+  [state params]
   (let [{:keys [group-id type]}
         (check-add-bool params)
 
         group
-        (lookup-shape file group-id)
+        (get-shape state group-id)
 
-        children
-        (->> (get group :shapes)
-             (not-empty))]
+        objects
+        (get-current-objects state)
 
-    (assert (some? children) "expect group to have at least 1 element")
+        bool
+        (-> group
+            (assoc :type :bool)
+            (assoc :bool-type type)
+            (update-bool-style-properties objects)
+            (types.path/update-bool-shape objects))
 
-    (let [objects  (lookup-objects file)
-          bool     (-> group
-                       (assoc :type :bool)
-                       (gsh/update-bool objects))
-          change   {:type :mod-obj
-                    :id (:id bool)
-                    :operations
-                    [{:type :set :attr :content :val (:content bool) :ignore-touched true}
-                     {:type :set :attr :type :val :bool :ignore-touched true}
-                     {:type :set :attr :bool-type :val type :ignore-touched true}
-                     {:type :set :attr :selrect :val (:selrect bool) :ignore-touched true}
-                     {:type :set :attr :points  :val (:points bool) :ignore-touched true}
-                     {:type :set :attr :x       :val (-> bool :selrect :x) :ignore-touched true}
-                     {:type :set :attr :y       :val (-> bool :selrect :y) :ignore-touched true}
-                     {:type :set :attr :width   :val (-> bool :selrect :width) :ignore-touched true}
-                     {:type :set :attr :height  :val (-> bool :selrect :height) :ignore-touched true}]}]
+        selrect
+        (get bool :selrect)
 
-      (-> file
-          (commit-change change :add-container true)
-          (assoc ::last-id group-id)))))
+        operations
+        [{:type :set :attr :content :val (:content bool) :ignore-touched true}
+         {:type :set :attr :type :val :bool :ignore-touched true}
+         {:type :set :attr :bool-type :val type :ignore-touched true}
+         {:type :set :attr :selrect :val selrect :ignore-touched true}
+         {:type :set :attr :points :val (:points bool) :ignore-touched true}
+         {:type :set :attr :x :val (get selrect :x) :ignore-touched true}
+         {:type :set :attr :y :val (get selrect :y) :ignore-touched true}
+         {:type :set :attr :width :val (get selrect :width) :ignore-touched true}
+         {:type :set :attr :height :val (get selrect :height) :ignore-touched true}
+         {:type :set :attr :fills :val (:fills bool) :ignore-touched true}
+         {:type :set :attr :strokes :val (:strokes bool) :ignore-touched true}]
+
+        change
+        {:type :mod-obj
+         :id (:id bool)
+         :operations operations}]
+
+    (-> state
+        (commit-change change :add-container true)
+        (assoc ::last-id group-id))))
 
 (defn add-shape
-  [file params]
+  [state params]
   (let [obj (-> params
                 (d/update-when :svg-attrs csvg/attrs->props)
                 (types.shape/setup-shape)
-                (assign-name file :type))]
-    (-> file
+                (assign-shape-name state))]
+    (-> state
         (commit-shape obj)
         (assoc ::last-id (:id obj)))))
 
 (defn add-library-color
-  [file color]
+  [state color]
   (let [color  (-> color
+                   (update :opacity d/nilv 1)
                    (update :id default-uuid)
                    (types.color/check-library-color color))
+
         change {:type :add-color
                 :color color}]
-    (-> file
+
+    (-> state
         (commit-change change)
         (assoc ::last-id (:id color)))))
 
 (defn add-library-typography
-  [file typography]
+  [state typography]
   (let [typography (-> typography
                        (update :id default-uuid)
                        (d/without-nils))
         change     {:type :add-typography
                     :id (:id typography)
                     :typography typography}]
-    (-> file
+    (-> state
         (commit-change change)
         (assoc ::last-id (:id typography)))))
 
 (defn add-component
-  [file params]
-  (let [change1 {:type :add-component
-                 :id (or (:id params) (uuid/next))
-                 :name (:name params)
-                 :path (:path params)
-                 :main-instance-id (:main-instance-id params)
-                 :main-instance-page (:main-instance-page params)}
+  [state params]
+  (let [{:keys [component-id file-id page-id frame-id name path]}
+        (-> (check-add-component params)
+            (update :component-id default-uuid))
 
-        comp-id (get change1 :id)
-
-        change2 {:type :mod-obj
-                 :id (:main-instance-id params)
-                 :operations
-                 [{:type :set :attr :component-root :val true}
-                  {:type :set :attr :component-id :val comp-id}
-                  {:type :set :attr :component-file :val (:id file)}]}]
-    (-> file
-        (commit-change change1)
-        (commit-change change2)
-        (assoc ::last-id comp-id)
-        (assoc ::current-frame-id comp-id))))
-
-(defn add-component-instance
-  [{:keys [id data] :as file} params]
-
-  (let [{:keys [component-id x y]}
-        (check-add-component-instance params)
-
-        component
-        (types.components-list/get-component data component-id)
+        file-id
+        (or file-id (::current-file-id state))
 
         page-id
-        (get file ::current-page-id)]
+        (or page-id (get state ::current-page-id))
 
-    (assert (uuid? page-id) "page-id is expected to be set")
-    (assert (uuid? component) "component is expected to exist")
+        frame-id
+        (or frame-id (get state ::current-frame-id))
 
-    ;; FIXME: this should be on files and not in pages-list
-    (let [page (types.pages-list/get-page (:data file) page-id)
-          pos  (gpt/point x y)
+        change1
+        (d/without-nils
+         {:type :add-component
+          :id component-id
+          :name (or name "anonmous")
+          :path path
+          :main-instance-id frame-id
+          :main-instance-page page-id})
 
-          [shape shapes]
-          (types.container/make-component-instance page component id pos)
+        change2
+        {:type :mod-obj
+         :id frame-id
+         :page-id page-id
+         :operations
+         [{:type :set :attr :component-root :val true}
+          {:type :set :attr :main-instance :val true}
+          {:type :set :attr :component-id :val component-id}
+          {:type :set :attr :component-file :val file-id}]}]
 
-          file
-          (reduce #(commit-change %1
-                                  {:type :add-obj
-                                   :id (:id %2)
-                                   :page-id (:id page)
-                                   :parent-id (:parent-id %2)
-                                   :frame-id (:frame-id %2)
-                                   :ignore-touched true
-                                   :obj %2})
-                  file
-                  shapes)]
-
-      (assoc file ::last-id (:id shape)))))
+    (-> state
+        (commit-change change1)
+        (commit-change change2))))
 
 (defn delete-shape
   [file id]
@@ -423,10 +491,12 @@
     :id id}))
 
 (defn update-shape
-  [file shape-id f]
-  (let [page-id   (::current-page-id file)
-        objects   (lookup-objects file)
+  [state shape-id f]
+  (let [page-id   (get state ::current-page-id)
+
+        objects   (get-current-objects state)
         old-shape (get objects shape-id)
+
         new-shape (f old-shape)
         attrs     (d/concat-set
                    (keys old-shape)
@@ -440,7 +510,7 @@
               changes
               (conj changes {:type :set :attr attr :val new-val :ignore-touched true}))))]
 
-    (-> file
+    (-> state
         (commit-change
          {:type :mod-obj
           :operations (reduce generate-operation [] attrs)
@@ -449,12 +519,12 @@
         (assoc ::last-id shape-id))))
 
 (defn add-guide
-  [file guide]
+  [state guide]
   (let [guide (cond-> guide
                 (nil? (:id guide))
-                (assoc :id (uuid/next)))
-        page-id (::current-page-id file)]
-    (-> file
+                (update :id default-uuid))
+        page-id (::current-page-id state)]
+    (-> state
         (commit-change
          {:type :set-guide
           :page-id page-id
@@ -463,24 +533,56 @@
         (assoc ::last-id (:id guide)))))
 
 (defn delete-guide
-  [file id]
-
-  (let [page-id (::current-page-id file)]
-    (commit-change file
+  [state id]
+  (let [page-id (::current-page-id state)]
+    (commit-change state
                    {:type :set-guide
                     :page-id page-id
                     :id id
                     :params nil})))
 
 (defn update-guide
-  [file guide]
-  (let [page-id (::current-page-id file)]
-    (commit-change file
+  [state guide]
+  (let [page-id (::current-page-id state)]
+    (commit-change state
                    {:type :set-guide
                     :page-id page-id
                     :id (:id guide)
                     :params guide})))
 
-(defn strip-image-extension [filename]
-  (let [image-extensions-re #"(\.png)|(\.jpg)|(\.jpeg)|(\.webp)|(\.gif)|(\.svg)$"]
-    (str/replace filename image-extensions-re "")))
+(defrecord BlobWrapper [mtype size blob])
+
+(defn add-file-media
+  [state params blob]
+  (assert (instance? BlobWrapper blob) "expect blob to be wrapped")
+
+  (let [media-id
+        (uuid/next)
+
+        file-id
+        (get state ::current-file-id)
+
+        {:keys [id width height name]}
+        (-> params
+            (update :id default-uuid)
+            (check-add-file-media params))]
+
+    (-> state
+        (update ::blobs assoc media-id blob)
+        (update ::media assoc media-id
+                {:id media-id
+                 :bucket "file-media-object"
+                 :content-type (get blob :mtype)
+                 :size (get blob :size)})
+        (update ::file-media assoc id
+                {:id id
+                 :created-at (dt/now)
+                 :name name
+                 :width width
+                 :height height
+                 :file-id file-id
+                 :media-id media-id
+                 :is-local true
+                 :mtype (get blob :mtype)})
+
+        (assoc ::last-id id))))

common/src/app/common/files/changes.cljc

@@ -24,6 +24,7 @@
    [app.common.types.grid :as ctg]
    [app.common.types.page :as ctp]
    [app.common.types.pages-list :as ctpl]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.tokens-lib :as ctob]
@@ -47,14 +48,14 @@
      [:type [:= :assign]]
      ;; NOTE: the full decoding is happening on the handler because it
      ;; needs a proper context of the current shape and its type
-     [:value [:map-of :keyword :any]]
+     [:value [:map-of :keyword ::sm/any]]
      [:ignore-touched {:optional true} :boolean]
      [:ignore-geometry {:optional true} :boolean]]]
    [:set
     [:map {:title "SetOperation"}
      [:type [:= :set]]
      [:attr :keyword]
-     [:val :any]
+     [:val ::sm/any]
      [:ignore-touched {:optional true} :boolean]
      [:ignore-geometry {:optional true} :boolean]]]
    [:set-touched
@@ -238,9 +239,9 @@
       [:component-id {:optional true} ::sm/uuid]
       [:ignore-touched {:optional true} :boolean]
       [:parent-id ::sm/uuid]
-      [:shapes :any]
+      [:shapes ::sm/any]
       [:index {:optional true} [:maybe :int]]
-      [:after-shape {:optional true} :any]
+      [:after-shape {:optional true} ::sm/any]
       [:component-swap {:optional true} :boolean]]]
 
     [:reorder-children
@@ -250,14 +251,14 @@
       [:component-id {:optional true} ::sm/uuid]
       [:ignore-touched {:optional true} :boolean]
       [:parent-id ::sm/uuid]
-      [:shapes :any]]]
+      [:shapes ::sm/any]]]
 
     [:add-page
      [:map {:title "AddPageChange"}
       [:type [:= :add-page]]
       [:id {:optional true} ::sm/uuid]
       [:name {:optional true} :string]
-      [:page {:optional true} :any]]]
+      [:page {:optional true} ::sm/any]]]
 
     [:mod-page
      [:map {:title "ModPageChange"}
@@ -310,12 +311,12 @@
     [:add-media
      [:map {:title "AddMediaChange"}
       [:type [:= :add-media]]
-      [:object ::ctf/media-object]]]
+      [:object ctf/schema:media]]]
 
     [:mod-media
      [:map {:title "ModMediaChange"}
       [:type [:= :mod-media]]
-      [:object ::ctf/media-object]]]
+      [:object ctf/schema:media]]]
 
     [:del-media
      [:map {:title "DelMediaChange"}
@@ -327,14 +328,14 @@
       [:type [:= :add-component]]
       [:id ::sm/uuid]
       [:name :string]
-      [:shapes {:optional true} [:vector {:gen/max 3} :any]]
+      [:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
       [:path {:optional true} :string]]]
 
     [:mod-component
      [:map {:title "ModCompoenentChange"}
       [:type [:= :mod-component]]
       [:id ::sm/uuid]
-      [:shapes {:optional true} [:vector {:gen/max 3} :any]]
+      [:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
       [:name {:optional true} :string]
       [:variant-id {:optional true} ::sm/uuid]
       [:variant-properties {:optional true} [:vector ::ctv/variant-property]]]]
@@ -411,7 +412,7 @@
     [:set-tokens-lib
      [:map {:title "SetTokensLib"}
       [:type [:= :set-tokens-lib]]
-      [:tokens-lib :any]]]
+      [:tokens-lib ::sm/any]]]
 
     [:set-token-set
      [:map {:title "SetTokenSetChange"}
@@ -425,7 +426,12 @@
       [:type [:= :set-token]]
       [:set-name :string]
       [:token-name :string]
-      [:token [:maybe ctob/schema:token-attrs]]]]]])
+      [:token [:maybe ctob/schema:token-attrs]]]]
+
+    [:set-base-font-size
+     [:map {:title "ModBaseFontSize"}
+      [:type [:= :set-base-font-size]]
+      [:base-font-size :string]]]]])
 
 (def schema:changes
   [:sequential {:gen/max 5 :gen/min 1} schema:change])
@@ -739,7 +745,7 @@
                 group
 
                 (= :bool (:type group))
-                (gsh/update-bool group objects)
+                (path/update-bool-shape group objects)
 
                 (:masked-group group)
                 (->> (map lookup children)
@@ -1068,6 +1074,13 @@
                                 (ctob/ensure-tokens-lib)
                                 (ctob/move-set-group from-path to-path before-path before-group))))
 
+;; === Base font size
+
+(defmethod process-change :set-base-font-size
+  [data {:keys [base-font-size]}]
+  (ctf/set-base-font-size data base-font-size))
+
+
 ;; === Operations
 
 (def ^:private decode-shape

common/src/app/common/files/changes_builder.cljc

@@ -18,24 +18,26 @@
    [app.common.schema :as sm]
    [app.common.types.component :as ctk]
    [app.common.types.file :as ctf]
+   [app.common.types.path :as path]
    [app.common.types.shape.layout :as ctl]
    [app.common.types.tokens-lib :as ctob]
    [app.common.uuid :as uuid]))
 
 ;; Auxiliary functions to help create a set of changes (undo + redo)
 
-(sm/register!
- ^{::sm/type ::changes}
- [:map {:title "changes"}
-  [:redo-changes vector?]
-  [:undo-changes seq?]
-  [:origin {:optional true} any?]
-  [:save-undo? {:optional true} boolean?]
-  [:stack-undo? {:optional true} boolean?]
-  [:undo-group {:optional true} any?]])
+(def schema:changes
+  (sm/register!
+   ^{::sm/type ::changes}
+   [:map {:title "changes"}
+    [:redo-changes vector?]
+    [:undo-changes seq?]
+    [:origin {:optional true} ::sm/any]
+    [:save-undo? {:optional true} boolean?]
+    [:stack-undo? {:optional true} boolean?]
+    [:undo-group {:optional true} ::sm/any]]))
 
 (def check-changes!
-  (sm/check-fn ::changes))
+  (sm/check-fn schema:changes))
 
 (defn empty-changes
   ([origin page-id]
@@ -124,28 +126,41 @@
 ; TODO: remove this when not needed
 (defn- assert-page-id!
   [changes]
-  (dm/assert!
-   "Give a page-id or call (with-page) before using this function"
-   (contains? (meta changes) ::page-id)))
+  (assert
+   (contains? (meta changes) ::page-id)
+   "Give a page-id or call (with-page) before using this function"))
+
+(defn- assert-page!
+  [changes]
+  (assert
+   (contains? (meta changes) ::page)
+   "Give a page or call (with-page) before using this function"))
 
 (defn- assert-container-id!
   [changes]
-  (dm/assert!
-   "Give a page-id or call (with-container) before using this function"
+  (assert
    (or (contains? (meta changes) ::page-id)
-       (contains? (meta changes) ::component-id))))
+       (contains? (meta changes) ::component-id))
+   "Give a page-id or call (with-container) before using this function"))
 
 (defn- assert-objects!
   [changes]
-  (dm/assert!
-   "Call (with-objects) before using this function"
-   (contains? (meta changes) ::file-data)))
+  (assert
+   (contains? (meta changes) ::file-data)
+   "Call (with-objects) before using this function"))
 
 (defn- assert-library!
   [changes]
-  (dm/assert!
-   "Call (with-library-data) before using this function"
-   (contains? (meta changes) ::library-data)))
+  (assert
+   (contains? (meta changes) ::library-data)
+   "Call (with-library-data) before using this function"))
+
+(defn- assert-file-data!
+  [changes]
+  (assert
+   (contains? (meta changes) ::file-data)
+   "Call (with-file-data) before using this function"))
+
 
 (defn- lookup-objects
   [changes]
@@ -154,9 +169,9 @@
 
 (defn apply-changes-local
   [changes & {:keys [apply-to-library?]}]
-  (dm/assert!
-   "expected valid changes"
-   (check-changes! changes))
+  (assert
+   (check-changes! changes)
+   "expected valid changes")
 
   (if-let [file-data (::file-data (meta changes))]
     (let [library-data  (::library-data (meta changes))
@@ -195,6 +210,7 @@
 
 (defn mod-page
   ([changes options]
+   (assert-page! changes)
    (let [page (::page (meta changes))]
      (mod-page changes page options)))
 
@@ -225,6 +241,7 @@
   ([changes type id namespace key value]
    (set-plugin-data changes type id nil namespace key value))
   ([changes type id page-id namespace key value]
+   (assert-file-data! changes)
    (let [data (::file-data (meta changes))
          old-val
          (case type
@@ -291,6 +308,8 @@
 
 (defn set-guide
   [changes id guide]
+  (assert-page-id! changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page    (::page (meta changes))
         old-val (dm/get-in page [:guides id])]
@@ -304,8 +323,11 @@
                                     :page-id page-id
                                     :id id
                                     :params old-val}))))
+
 (defn set-flow
   [changes id flow]
+  (assert-page-id! changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page    (::page (meta changes))
         old-val (dm/get-in page [:flows id])
@@ -324,6 +346,8 @@
 
 (defn set-comment-thread-position
   [changes {:keys [id frame-id position] :as thread}]
+  (assert-page-id! changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page    (::page (meta changes))
 
@@ -345,6 +369,8 @@
 
 (defn set-default-grid
   [changes type params]
+  (assert-page-id! changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page    (::page (meta changes))
         old-val (dm/get-in page [:grids type])
@@ -498,6 +524,7 @@
                            :or {ignore-geometry? false ignore-touched false with-objects? false}}]
    (assert-container-id! changes)
    (assert-objects! changes)
+   (assert-page-id! changes)
    (let [page-id      (::page-id (meta changes))
          component-id (::component-id (meta changes))
          objects      (lookup-objects changes)
@@ -659,10 +686,10 @@
                                  (empty? children) ;; a parent with no children will be deleted,
                                  nil               ;; so it does not need resize
 
-                                 (= (:type parent) :bool)
-                                 (gsh/update-bool parent objects)
+                                 (cfh/bool-shape? parent)
+                                 (path/update-bool-shape parent objects)
 
-                                 (= (:type parent) :group)
+                                 (cfh/group-shape? parent)
                                  ;; FIXME: this functions should be
                                  ;; normalized in the same way as
                                  ;; update-bool in order to make all
@@ -846,6 +873,7 @@
 
 (defn set-tokens-lib
   [changes tokens-lib]
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-tokens-lib (get library-data :tokens-lib)]
     (-> changes
@@ -1135,3 +1163,16 @@
 (defn get-page-id
   [changes]
   (::page-id (meta changes)))
+
+(defn set-base-font-size
+  [changes new-base-font-size]
+  (assert-file-data! changes)
+  (let [file-data  (::file-data (meta changes))
+        previous-font-size (ctf/get-base-font-size file-data)]
+    (-> changes
+        (update :redo-changes conj {:type :set-base-font-size
+                                    :base-font-size new-base-font-size})
+
+        (update :undo-changes conj {:type :set-base-font-size
+                                    :base-font-size previous-font-size})
+        (apply-changes-local))))

common/src/app/common/files/helpers.cljc

@@ -626,6 +626,9 @@
               (map? (:fill-image form))
               (update-in [:fill-image :id] lookup-index)
 
+              (map? (:stroke-image form))
+              (update-in [:stroke-image :id] lookup-index)
+
               ;; This covers old shapes and the new :fills.
               (uuid? (:fill-color-ref-file form))
               (update :fill-color-ref-file lookup-index)

common/src/app/common/files/migrations.cljc

@@ -31,6 +31,7 @@
    [app.common.types.shape :as cts]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
+   [app.common.types.text :as cttx]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
    [cuerdas.core :as str]))
@@ -58,18 +59,21 @@
   (map :name))
 
 (defn migrate
-  [{:keys [id] :as file}]
+  [{:keys [id] :as file} libs]
 
   (let [diff
         (set/difference available-migrations (:migrations file))
 
+        data (-> (:data file)
+                 (assoc :libs libs))
+
         data
-        (reduce migrate-data (:data file) diff)
+        (reduce migrate-data data diff)
 
         data
         (-> data
             (assoc :id id)
-            (dissoc :version))]
+            (dissoc :version :libs))]
 
     (-> file
         (assoc :data data)
@@ -88,7 +92,7 @@
     result))
 
 (defn migrate-file
-  [file]
+  [file libs]
   (binding [cfeat/*new* (atom #{})]
     (let [version (or (:version file)
                       (-> file :data :version))]
@@ -104,7 +108,7 @@
           ;; this code from this function that executes on
           ;; each file migration operation
           (update :features cfeat/migrate-legacy-features)
-          (migrate)
+          (migrate libs)
           (update :features (fnil into #{}) (deref cfeat/*new*))))))
 
 (defn migrated?
@@ -1324,6 +1328,85 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+
+(defmethod migrate-data "0004-add-partial-text-touched-flags"
+  [data _]
+  (letfn [(update-object [page object]
+            (if (and (cfh/text-shape? object)
+                     (ctk/in-component-copy? object))
+              (let [file            {:id (:id data) :data data}
+                    libs            (when (:libs data)
+                                      (deref (:libs data)))
+                    ref-shape       (ctf/find-ref-shape file page libs object
+                                                        {:include-deleted? true :with-context? true})
+                    partial-touched (when ref-shape
+                                      (cttx/get-diff-type (:content object) (:content ref-shape)))]
+                (if (seq partial-touched)
+                  (update object :touched (fn [touched]
+                                            (reduce #(ctk/set-touched-group %1 %2)
+                                                    touched
+                                                    partial-touched)))
+                  object))
+              object))
+
+          (update-page [page]
+            (d/update-when page :objects d/update-vals (partial update-object page)))]
+
+    (update data :pages-index d/update-vals update-page)))
+
+(defmethod migrate-data "0005-deprecate-image-type"
+  [data _]
+  (letfn [(update-object [object]
+            (if (cfh/image-shape? object)
+              (let [metadata (:metadata object)
+                    fills (into [{:fill-image (assoc metadata :keep-aspect-ratio false)
+                                  :opacity    1}]
+                                (:fills object))]
+                (-> object
+                    (assoc :fills fills)
+                    (dissoc :metadata)
+                    (assoc :type :rect)))
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
+(defmethod migrate-data "0006-fix-old-texts-fills"
+  [data _]
+  (letfn [(fix-fills [node]
+            (let [fills (cond
+                          (or (some? (:fill-color node))
+                              (some? (:fill-opacity node))
+                              (some? (:fill-color-gradient node)))
+                          [(d/without-nils (select-keys node [:fill-color :fill-opacity :fill-color-gradient
+                                                              :fill-color-ref-id :fill-color-ref-file]))]
+
+                          (nil? (:fills node))
+                          [{:fill-color "#000000" :fill-opacity 1}]
+
+                          :else
+                          (:fills node))]
+              (-> node
+                  (assoc :fills fills)
+                  (dissoc :fill-color :fill-opacity :fill-color-gradient
+                          :fill-color-ref-id :fill-color-ref-file))))
+
+          (update-object [object]
+            (if (cfh/text-shape? object)
+              (update object :content (partial txt/transform-nodes identity fix-fills))
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -1382,4 +1465,7 @@
          "0002-normalize-bool-content"
          "0002-clean-shape-interactions"
          "0003-fix-root-shape"
-         "0003-convert-path-content"]))
+         "0003-convert-path-content"
+         "0004-add-partial-text-touched-flags"
+         "0005-deprecate-image-type"
+         "0006-fix-old-texts-fills"]))

common/src/app/common/files/shapes_builder.cljc

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.shapes-builder
+(ns app.common.files.shapes-builder
   "A SVG to Shapes builder."
   (:require
    [app.common.colors :as clr]
@@ -21,7 +21,7 @@
    [app.common.math :as mth]
    [app.common.schema :as sm :refer [max-safe-int min-safe-int]]
    [app.common.svg :as csvg]
-   [app.common.svg.path :as path]
+   [app.common.types.path :as path]
    [app.common.types.path.segment :as path.segm]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
@@ -219,7 +219,7 @@
 (defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
   (when (and (contains? attrs :d) (seq (:d attrs)))
     (let [transform (csvg/parse-transform (:transform attrs))
-          content   (cond-> (path/parse (:d attrs))
+          content   (cond-> (path/from-string (:d attrs))
                       (some? transform)
                       (path.segm/transform-content transform))
 

common/src/app/common/files/variant.cljc

@@ -8,8 +8,7 @@
    [app.common.data.macros :as dm]
    [app.common.types.component :as ctc]
    [app.common.types.components-list :as ctcl]
-   [app.common.types.variant :as ctv]
-   [cuerdas.core :as str]))
+   [app.common.types.variant :as ctv]))
 
 
 (defn find-variant-components
@@ -21,11 +20,6 @@
        (map #(ctcl/get-component data % true))
        reverse))
 
-(defn- dashes-to-end
-  [property-values]
-  (let [dashes (if (some #(= % "--") property-values) ["--"] [])]
-    (concat (remove #(= % "--") property-values) dashes)))
-
 
 (defn extract-properties-names
   [shape data]
@@ -42,10 +36,7 @@
        (group-by :name)
        (map (fn [[k v]]
               {:name k
-               :value (->> v
-                           (map #(if (str/empty? (:value %)) "--" (:value %)))
-                           distinct
-                           dashes-to-end)}))))
+               :value (->> v (map :value) distinct)}))))
 
 (defn get-variant-mains
   [component data]

common/src/app/common/flags.cljc

@@ -116,6 +116,7 @@
     :terms-and-privacy-checkbox
     ;; Only for developtment.
     :tiered-file-data-storage
+    :token-units
     :transit-readable-response
     :user-feedback
     ;; TODO: remove this flag.
@@ -126,7 +127,8 @@
     :render-wasm-dpr
     :hide-release-modal
     :subscriptions
-    :subscriptions-old})
+    :subscriptions-old
+    :frontend-binary-fills})
 
 (def all-flags
   (set/union email login varia))

common/src/app/common/geom/shapes.cljc

@@ -164,7 +164,6 @@
 (dm/export gtr/calculate-geometry)
 (dm/export gtr/update-group-selrect)
 (dm/export gtr/update-mask-selrect)
-(dm/export gtr/update-bool)
 (dm/export gtr/apply-transform)
 (dm/export gtr/transform-shape)
 (dm/export gtr/transform-selrect)
@@ -195,6 +194,7 @@
 
 ;; Rect
 (dm/export grc/rect->points)
+(dm/export grc/center->rect)
 
 ;;
 (dm/export gsff/fit-frame-modifiers)

common/src/app/common/geom/shapes/transforms.cljc

@@ -346,29 +346,32 @@
 
         center    (gco/points->center points)
         selrect   (calculate-selrect points center)
-        transform (calculate-transform points center selrect)
-        inverse   (when (some? transform) (gmt/inverse transform))]
 
-    (if-not (and (some? inverse) (some? transform))
-      shape
-      (let [type     (dm/get-prop shape :type)
-            rotation (mod (+ (d/nilv (:rotation shape) 0)
-                             (d/nilv (dm/get-in shape [:modifiers :rotation]) 0))
-                          360)
+        [transform inverse]
+        (let [transform (calculate-transform points center selrect)
+              inverse (when (some? transform) (gmt/inverse transform))]
+          (if (and (some? transform) (some? inverse))
+            [transform inverse]
+            [(:transform shape (gmt/matrix)) (:transform-inverse shape (gmt/matrix))]))
 
-            shape    (if (or (= type :path) (= type :bool))
-                       (update shape :content path/transform-content transform-mtx)
-                       (assoc shape
-                              :x (dm/get-prop selrect :x)
-                              :y (dm/get-prop selrect :y)
-                              :width (dm/get-prop selrect :width)
-                              :height (dm/get-prop selrect :height)))]
-        (-> shape
-            (assoc :transform transform)
-            (assoc :transform-inverse inverse)
-            (assoc :selrect selrect)
-            (assoc :points points)
-            (assoc :rotation rotation))))))
+        type     (dm/get-prop shape :type)
+        rotation (mod (+ (d/nilv (:rotation shape) 0)
+                         (d/nilv (dm/get-in shape [:modifiers :rotation]) 0))
+                      360)
+
+        shape    (if (or (= type :path) (= type :bool))
+                   (update shape :content path/transform-content transform-mtx)
+                   (assoc shape
+                          :x (dm/get-prop selrect :x)
+                          :y (dm/get-prop selrect :y)
+                          :width (dm/get-prop selrect :width)
+                          :height (dm/get-prop selrect :height)))]
+    (-> shape
+        (assoc :transform transform)
+        (assoc :transform-inverse inverse)
+        (assoc :selrect selrect)
+        (assoc :points points)
+        (assoc :rotation rotation))))
 
 (defn apply-transform
   "Given a new set of points transformed, set up the rectangle so it keeps
@@ -453,13 +456,6 @@
         (assoc :flip-x  (-> mask :flip-x))
         (assoc :flip-y  (-> mask :flip-y)))))
 
-(defn update-bool
-  "Calculates the selrect+points for the boolean shape"
-  [shape objects]
-  (let [content (path/calc-bool-content shape objects)
-        shape   (assoc shape :content content)]
-    (path/update-geometry shape)))
-
 ;; FIXME: revisit
 (defn update-shapes-geometry
   [objects ids]
@@ -474,7 +470,7 @@
                   (update-mask-selrect shape children)
 
                   (cfh/bool-shape? shape)
-                  (update-bool shape objects)
+                  (path/update-bool-shape shape objects)
 
                   (cfh/group-shape? shape)
                   (update-group-selrect shape children)

common/src/app/common/logic/libraries.cljc

@@ -29,6 +29,7 @@
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctl]
+   [app.common.types.text :as cttx]
    [app.common.types.token :as cto]
    [app.common.types.typography :as cty]
    [app.common.types.variant :as ctv]
@@ -596,7 +597,7 @@
     (generate-sync-shape-direct changes file libraries container shape-id false)))
 
 (defmethod generate-sync-shape :colors
-  [_ changes library-id _ shape _ libraries _]
+  [_ changes library-id _ shape libraries _]
   (shape-log :debug (:id shape) nil :msg "Sync colors of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some colors of the library. The value of the
@@ -607,7 +608,7 @@
                        #(ctc/sync-shape-colors % library-id library-colors))))
 
 (defmethod generate-sync-shape :typographies
-  [_ changes library-id container shape _ libraries _]
+  [_ changes library-id container shape libraries _]
   (shape-log :debug (:id shape) nil :msg "Sync typographies of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some typographies of the library. The attributes
@@ -1663,24 +1664,46 @@
                                        {:type :reg-objects
                                         :shapes all-parents})]))))
 
+
 (defn- add-update-attr-operations
-  [attr dest-shape origin-shape roperations uoperations touched]
-  (let [;; position-data is a special case because can be affected by :geometry-group and :content-group
+  [attr dest-shape origin-shape roperations uoperations touched is-text-partial-change?]
+  (let [orig-value (get origin-shape attr)
+        dest-value (get dest-shape attr)
+        ;; position-data is a special case because can be affected by :geometry-group and :content-group
         ;; so, if the position-data changes but the geometry is touched we need to reset the position-data
         ;; so it's calculated again
         reset-pos-data?
         (and (cfh/text-shape? origin-shape)
              (= attr :position-data)
-             (not= (get origin-shape attr) (get dest-shape attr))
+             (not= orig-value dest-value)
              (touched :geometry-group))
 
+        ;; We want to split the changes on the text itself and on its properties
+        text-value
+        (when is-text-partial-change?
+          (cond
+            (touched :text-content-structure-same-attrs)
+            ;; Keep the dest structure and texts, update its attrs to make them like the origin
+            (cttx/copy-attrs-keys dest-value (cttx/get-first-paragraph-text-attrs orig-value))
+
+            (touched :text-content-text)
+            ;; Keep the texts touched in dest: copy the texts from dest over the attrs of origin
+            (cttx/copy-text-keys dest-value orig-value)
+
+            (touched :text-content-attribute)
+            ;; Keep the attrs touched in dest: copy the texts from origin over the attrs of dest
+            (cttx/copy-text-keys orig-value dest-value)))
+
+        val (cond
+              ;; If position data changes and the geometry group is touched
+              ;; we need to put to nil so we can regenerate it
+              reset-pos-data? nil
+              is-text-partial-change? text-value
+              :else orig-value)
+
         roperation {:type :set
                     :attr attr
-                    :val (cond
-                           ;; If position data changes and the geometry group is touched
-                           ;; we need to put to nil so we can regenerate it
-                           reset-pos-data? nil
-                           :else (get origin-shape attr))
+                    :val val
                     :ignore-touched true}
         uoperation {:type :set
                     :attr attr
@@ -1689,6 +1712,33 @@
     [(conj roperations roperation)
      (conj uoperations uoperation)]))
 
+(defn- is-text-partial-change?
+  "Check if the attr update is a text partial change"
+  [origin-shape dest-shape attr touched]
+  (let [partial-text-keys [:text-content-attribute :text-content-text]
+        active-keys       (filter touched partial-text-keys)
+        orig-content      (get origin-shape attr)
+        orig-attrs        (cttx/get-first-paragraph-text-attrs orig-content)
+
+        equal-orig-attrs? (cttx/equal-attrs? orig-content orig-attrs)]
+    (and
+     (or
+     ;; One and only one of the keys is pressent
+      (= 1 (count active-keys))
+      (and
+       (not (touched :text-content-attribute))
+       (touched :text-content-structure-same-attrs)))
+
+     (or
+      ;; Both has the same structure
+      (cttx/equal-structure? (:content origin-shape) (:content dest-shape))
+
+      ;; The origin and destiny have different structures, but each have the same attrs
+      ;; for all the items on its content tree
+      (and
+       equal-orig-attrs?
+       (touched :text-content-structure-same-attrs))))))
+
 (defn- update-attrs
   "The main function that implements the attribute sync algorithm. Copy
   attributes that have changed in the origin shape to the dest shape.
@@ -1731,12 +1781,30 @@
             :always
             (generate-update-tokens container dest-shape origin-shape touched omit-touched?))
 
-          (let [attr-group (get ctk/sync-attrs attr)
+          (let [attr-group        (get ctk/sync-attrs attr)
+                ;; On texts, when we want to omit the touched attrs, both text (the actual letters)
+                ;; and attrs (bold, font, etc) are in the same attr :content.
+                ;; If only one of them is touched, we want to adress this case and
+                ;; only update the untouched one
+                text-partial-change? (when (and
+                                            omit-touched?
+                                            (= :text (:type origin-shape))
+                                            (= :content attr)
+                                            (touched attr-group))
+                                       (is-text-partial-change? origin-shape dest-shape attr touched))
+
+                skip-operations? (or (= (get origin-shape attr) (get dest-shape attr))
+                                     (and (touched attr-group)
+                                          omit-touched?
+                                          ;; When it is a text-partial-change, we should generate operations
+                                          ;; even when omit-touched? is true, but updating only the text or
+                                          ;; the attributes, omiting the other part
+                                          (not text-partial-change?)))
+
                 [roperations' uoperations']
-                (if (or (= (get origin-shape attr) (get dest-shape attr))
-                        (and (touched attr-group) omit-touched?))
+                (if skip-operations?
                   [roperations uoperations]
-                  (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
+                  (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched text-partial-change?))]
             (recur (next attrs)
                    roperations'
                    uoperations')))))))
@@ -1771,7 +1839,7 @@
                    ;; If the attr is not touched in the origin shape, don't copy it
                    (not (touched-origin attr-group)))
                 [roperations uoperations]
-                (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
+                (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched false))]
           (recur (next attrs)
                  roperations'
                  uoperations'))
@@ -2055,7 +2123,8 @@
                     (pcb/with-objects objects)
                     (pcb/resize-parents new-objects-ids)
                     ;; Fix the order of the children inside the parent
-                    (pcb/reorder-children parent-id (get-in objects [parent-id :shapes])))]
+                    (cond-> (ctl/any-layout? objects parent-id)
+                      (pcb/reorder-children parent-id (get-in objects [parent-id :shapes]))))]
     (assoc changes :file-id library-id)))
 
 (defn generate-detach-component
@@ -2190,7 +2259,9 @@
                               :starting-frame frame-id}]
 
                 (vswap! unames conj name)
-                (pcb/set-flow changes flow-id new-flow)))
+                (-> changes
+                    (pcb/with-page page)
+                    (pcb/set-flow flow-id new-flow))))
 
             changes
             (->> shapes

common/src/app/common/logic/shapes.cljc

@@ -151,7 +151,9 @@
          changes
          (reduce (fn [changes {:keys [id] :as flow}]
                    (if (contains? ids-to-delete (:starting-frame flow))
-                     (pcb/set-flow changes id nil)
+                     (-> changes
+                         (pcb/with-page page)
+                         (pcb/set-flow id nil))
                      changes))
                  changes
                  (:flows page))
@@ -213,7 +215,9 @@
               (map :id))
 
          changes (reduce (fn [changes guide-id]
-                           (pcb/set-flow changes guide-id nil))
+                           (-> changes
+                               (pcb/with-page page)
+                               (pcb/set-flow guide-id nil)))
                          changes
                          guides-to-delete)
 

common/src/app/common/logic/variant_properties.cljc

@@ -60,6 +60,17 @@
         (pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
 
 
+(defn generate-set-variant-error
+  [changes component-id value]
+  (let [data      (pcb/get-library-data changes)
+        component (ctcl/get-component data component-id true)
+        main-id   (:main-instance-id component)]
+    (-> changes
+        (pcb/update-shapes [main-id] (if (str/blank? value)
+                                       #(dissoc % :variant-error)
+                                       #(assoc % :variant-error value))))))
+
+
 (defn generate-add-new-property
   [changes variant-id & {:keys [fill-values? property-name]}]
   (let [data               (pcb/get-library-data changes)

common/src/app/common/logic/variants.cljc

@@ -9,21 +9,6 @@
    [app.common.types.file :as ctf]
    [app.common.types.variant :as ctv]))
 
-
-(defn- generate-path
-  [path objects base-id shape]
-  (let [get-type #(case %
-                    :frame :container
-                    :group :container
-                    :rect  :shape
-                    :circle :shape
-                    :bool :shape
-                    :path :shape
-                    %)]
-    (if (= base-id (:id shape))
-      path
-      (generate-path (str path " " (:name shape) (get-type (:type shape))) objects base-id (get objects (:parent-id shape))))))
-
 (defn generate-add-new-variant
   [changes shape variant-id new-component-id new-shape-id prop-num]
   (let [data                (pcb/get-library-data changes)
@@ -46,20 +31,56 @@
         (clvp/generate-update-property-value new-component-id prop-num value)
         (pcb/change-parent (:parent-id shape) [new-shape] 0))))
 
+(defn- generate-path
+  [path objects base-id shape]
+  (let [get-type #(case %
+                    :frame :container
+                    :group :container
+                    :rect  :shape
+                    :circle :shape
+                    :bool :shape
+                    :path :shape
+                    %)]
+    (if (= base-id (:id shape))
+      path
+      (generate-path (str path " " (:name shape) (get-type (:type shape))) objects base-id (get objects (:parent-id shape))))))
+
+(defn- add-unique-path
+  "Adds a new property :shape-path to the shape, with the path of the shape.
+   Suffixes like -1, -2, etc. are added to ensure uniqueness."
+  [shapes objects base-id]
+  (letfn [(unique-path [shape counts]
+            (let [path (generate-path "" objects base-id shape)
+                  num  (get counts path 1)]
+              [(str path "-" num) (update counts path (fnil inc 1))]))]
+    (first
+     (reduce
+      (fn [[result counts] shape]
+        (let [[shape-path counts'] (unique-path shape counts)]
+          [(conj result (assoc shape :shape-path shape-path)) counts']))
+      [[] {}]
+      shapes))))
+
+
 (defn generate-keep-touched
   [changes new-shape original-shape original-shapes page libraries]
-  (let [objects      (pcb/get-objects changes)
-        new-path-map (into {}
-                           (map (fn [shape] {(generate-path "" objects (:id new-shape) shape) shape}))
-                           (cfh/get-children-with-self objects (:id new-shape)))
+  (let [objects            (pcb/get-objects changes)
+        orig-objects       (into {} (map (juxt :id identity) original-shapes))
+        orig-shapes-w-path (add-unique-path
+                            (reverse original-shapes)
+                            orig-objects
+                            (:id original-shape))
+        new-shapes-w-path  (add-unique-path
+                            (reverse (cfh/get-children-with-self objects (:id new-shape)))
+                            objects
+                            (:id new-shape))
+        new-shapes-map     (into {} (map (juxt :shape-path identity) new-shapes-w-path))
+        orig-touched      (filter (comp seq :touched) orig-shapes-w-path)
 
-        orig-touched (filter (comp seq :touched) original-shapes)
-        orig-objects (into {} (map (juxt :id identity) original-shapes))
-        container    (ctn/make-container page :page)]
+        container          (ctn/make-container page :page)]
     (reduce
      (fn [changes touched-shape]
-       (let [path (generate-path "" orig-objects (:id original-shape) touched-shape)
-             related-shape  (get new-path-map path)
+       (let [related-shape  (get new-shapes-map (:shape-path touched-shape))
              orig-ref-shape (ctf/find-ref-shape nil container libraries touched-shape)]
          (if related-shape
            (cll/update-attrs-on-switch

common/src/app/common/media.cljc

@@ -5,8 +5,8 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.media
+  "Media assets helpers (images, fonts, etc)"
   (:require
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 ;; We have added ".ttf" as string to solve a problem with chrome input selector
@@ -48,38 +48,28 @@
 (defn mtype->extension [mtype]
   ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
   (case mtype
-    "image/apng"         ".apng"
-    "image/avif"         ".avif"
-    "image/gif"          ".gif"
-    "image/jpeg"         ".jpg"
-    "image/png"          ".png"
-    "image/svg+xml"      ".svg"
-    "image/webp"         ".webp"
-    "application/zip"    ".zip"
-    "application/penpot" ".penpot"
-    "application/pdf"    ".pdf"
-    "text/plain"         ".txt"
+    "image/apng"               ".apng"
+    "image/avif"               ".avif"
+    "image/gif"                ".gif"
+    "image/jpeg"               ".jpg"
+    "image/png"                ".png"
+    "image/svg+xml"            ".svg"
+    "image/webp"               ".webp"
+    "application/zip"          ".zip"
+    "application/penpot"       ".penpot"
+    "application/pdf"          ".pdf"
+    "text/plain"               ".txt"
+    "font/woff"                ".woff"
+    "font/woff2"               ".woff2"
+    "font/ttf"                 ".ttf"
+    "font/otf"                 ".otf"
+    "application/octet-stream" ".bin"
     nil))
 
-(s/def ::id uuid?)
-(s/def ::name string?)
-(s/def ::width number?)
-(s/def ::height number?)
-(s/def ::created-at inst?)
-(s/def ::modified-at inst?)
-(s/def ::mtype string?)
-(s/def ::uri string?)
-
-(s/def ::media-object
-  (s/keys :req-un [::id
-                   ::name
-                   ::width
-                   ::height
-                   ::mtype
-                   ::created-at
-                   ::modified-at
-                   ::uri]))
-
+(defn strip-image-extension
+  [filename]
+  (let [image-extensions-re #"(\.png)|(\.jpg)|(\.jpeg)|(\.webp)|(\.gif)|(\.svg)$"]
+    (str/replace filename image-extensions-re "")))
 
 (defn parse-font-weight
   [variant]

common/src/app/common/schema.cljc

@@ -211,8 +211,7 @@
 
 (defn lazy-validator
   [s]
-  (let [s   (schema s)
-        vfn (delay (validator s))]
+  (let [vfn (delay (validator s))]
     (fn [v] (@vfn v))))
 
 (defn lazy-explainer
@@ -998,6 +997,8 @@
      {:title "agent"
       :description "instance of clojure agent"}}))
 
+(register! ::any (mu/update-properties :any assoc :gen/gen sg/any))
+
 ;; ---- PREDICATES
 
 (def valid-safe-number?

common/src/app/common/schema/desc_js_like.cljc

@@ -7,6 +7,7 @@
 (ns app.common.schema.desc-js-like
   (:require
    [app.common.data :as d]
+   [app.common.schema :as-alias sm]
    [cuerdas.core :as str]
    [malli.core :as m]
    [malli.util :as mu]))
@@ -90,7 +91,7 @@
 (defmethod visit :int [_ schema _ _] (str "integer" (-titled schema) (-min-max-suffix-number schema)))
 (defmethod visit :double [_ schema _ _] (str "double" (-titled schema) (-min-max-suffix-number schema)))
 (defmethod visit :select-keys [_ schema _ options] (describe* (m/deref schema) options))
-(defmethod visit :and [_ s children _] (str (str/join ", and " children) (-titled s)))
+(defmethod visit :and [_ s children _] (str (str/join " && " children) (-titled s)))
 (defmethod visit :enum [_ s children _options] (str "enum" (-titled s) " of " (str/join ", " children)))
 (defmethod visit :maybe [_ _ children _] (str (first children) " nullable"))
 (defmethod visit :tuple [_ _ children _] (str "(" (str/join ", " children) ")"))
@@ -106,7 +107,8 @@
 (defmethod visit :qualified-symbol [_ _ _ _] "qualified symbol")
 (defmethod visit :uuid [_ _ _ _] "uuid")
 (defmethod visit :boolean [_ _ _ _] "boolean")
-(defmethod visit :keyword [_ _ _ _] "keyword")
+(defmethod visit :keyword [_ _ _ _] "string")
+(defmethod visit :fn [_ _ _ _] "FN")
 
 (defmethod visit :vector [_ _ children _]
   (str "[" (last children) "]"))
@@ -123,10 +125,12 @@
 (defmethod visit :repeat [_ schema children _]
   (str "repeat " (-diamond (first children)) (-repeat-suffix schema)))
 
-
 (defmethod visit :set [_ schema children _]
   (str "set[" (first children) "]" (minmax-suffix schema)))
 
+(defmethod visit ::sm/set [_ schema children _]
+  (str "set[" (first children) "]" (minmax-suffix schema)))
+
 (defmethod visit ::m/val [_ schema children _]
   (let [suffix (minmax-suffix schema)]
     (cond-> (first children)
@@ -152,7 +156,6 @@
     (or (:title props)
         "*")))
 
-
 (defmethod visit :map
   [_ schema children {:keys [::level ::max-level] :as options}]
   (let [props   (m/properties schema)
@@ -172,13 +175,11 @@
                                       ": " s)))
                           (str/join ",\n"))
 
-            header   (cond-> (if (zero? level)
-                               (str "type " title)
-                               (str title))
+            header   (cond-> (str "type " title)
                        closed?       (str "!")
                        (some? title) (str " "))]
 
-        (str header "{\n" entries "\n" (pad "}" level))))))
+        (str (pad header level) "{\n" entries "\n" (pad "}\n" level))))))
 
 (defmethod visit :multi
   [_ s children {:keys [::level ::max-level] :as options}]
@@ -205,18 +206,18 @@
 
 (defmethod visit :merge
   [_ schema children _]
-  (let [entries (str/join " , " children)
+  (let [entries (str/join ",\n" children)
         props   (m/properties schema)
         title   (or (some-> (:title props) str/camel str/capital)
                     "<untitled>")]
-    (str "merge object " title " { " entries " }")))
+    (str "merge type " title " { \n" entries "\n}\n")))
 
-(defmethod visit :app.common.schema/one-of
-  [_ _  children _]
+(defmethod visit ::sm/one-of
+  [_ _ children _]
   (let [elems (last children)]
-    (str "OneOf[" (->> elems
-                       (map d/name)
-                       (str/join ",")) "]")))
+    (str "string oneOf (" (->> elems
+                               (map d/name)
+                               (str/join "|")) ")")))
 
 (defmethod visit :schema [_ schema children options]
   (visit ::m/schema schema children options))

common/src/app/common/schema/generators.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema.generators
-  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector keyword int double])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -38,10 +38,6 @@
   ([s opts]
    (mg/generator s (assoc opts :registry sr/default-registry))))
 
-(defn filter
-  [pred gen]
-  (tg/such-that pred gen 100))
-
 (defn small-double
   [& {:keys [min max] :or {min -100 max 100}}]
   (tg/double* {:min min, :max max, :infinite? false, :NaN? false}))
@@ -61,7 +57,7 @@
 (defn word-keyword
   []
   (->> (word-string)
-       (tg/fmap keyword)))
+       (tg/fmap c/keyword)))
 
 (defn email
   []
@@ -100,12 +96,11 @@
                           (c/map second))
                          (c/map list bools elements)))))))
 
-(def any tg/any)
-(def boolean tg/boolean)
-
-(defn set
-  [g]
-  (tg/set g))
+(defn map-of
+  ([kg vg]
+   (tg/map kg vg {:min-elements 1 :max-elements 3}))
+  ([kg vg opts]
+   (tg/map kg vg opts)))
 
 (defn elements
   [s]
@@ -119,6 +114,10 @@
   [f g]
   (tg/fmap f g))
 
+(defn filter
+  [pred gen]
+  (tg/such-that pred gen 100))
+
 (defn mcat
   [f g]
   (tg/bind g f))
@@ -130,3 +129,18 @@
 (defn vector
   [& opts]
   (apply tg/vector opts))
+
+(defn set
+  [g]
+  (tg/set g))
+
+;; Static Generators
+
+(def boolean tg/boolean)
+(def text (word-string))
+(def double (small-double))
+(def int (small-int))
+(def keyword (word-keyword))
+
+(def any
+  (tg/one-of [text boolean double int keyword]))

common/src/app/common/schema/openapi.cljc

@@ -97,7 +97,8 @@
 (defmethod visit :enum [_ _ children options] (merge (some-> (m/-infer children) (transform* options)) {:enum children}))
 (defmethod visit :maybe [_ _ children _] {:oneOf (conj children {:type "null"})})
 (defmethod visit :tuple [_ _ children _] {:type "array", :items children, :additionalItems false})
-(defmethod visit :re [_ schema _ options] {:type "string", :pattern (first (m/children schema options))})
+(defmethod visit :re [_ schema _ options]
+  {:type "string", :pattern (str (first (m/children schema options)))})
 (defmethod visit :nil [_ _ _ _] {:type "null"})
 
 (defmethod visit :string [_ schema _ _]

common/src/app/common/svg.cljc

@@ -6,8 +6,6 @@
 
 (ns app.common.svg
   (:require
-   #?(:clj  [clojure.xml :as xml]
-      :cljs [tubax.core :as tubax])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.matrix :as gmt]
@@ -15,15 +13,7 @@
    [app.common.geom.shapes :as gsh]
    [app.common.math :as mth]
    [app.common.uuid :as uuid]
-   [cuerdas.core :as str])
-  #?(:clj
-     (:import
-      clojure.lang.XMLHandler
-      java.io.InputStream
-      javax.xml.XMLConstants
-      javax.xml.parsers.SAXParserFactory
-      org.apache.commons.io.IOUtils)))
-
+   [cuerdas.core :as str]))
 
 ;; Regex for XML ids per Spec
 ;; https://www.w3.org/TR/2008/REC-xml-20081126/#sec-common-syn
@@ -1030,24 +1020,3 @@
                          :height (d/parse-integer (:height attrs) 0)})))]
     (reduce-nodes redfn [] svg-data)))
 
-#?(:clj
-   (defn- secure-parser-factory
-     [^InputStream input ^XMLHandler handler]
-     (.. (doto (SAXParserFactory/newInstance)
-           (.setFeature XMLConstants/FEATURE_SECURE_PROCESSING true)
-           (.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true))
-         (newSAXParser)
-         (parse input handler))))
-
-(defn strip-doctype
-  [data]
-  (cond-> data
-    (str/includes? data "<!DOCTYPE")
-    (str/replace #"<\!DOCTYPE[^>]*>" "")))
-
-(defn parse
-  [text]
-  #?(:cljs (tubax/xml->clj text)
-     :clj  (let [text (strip-doctype text)]
-             (dm/with-open [istream (IOUtils/toInputStream text "UTF-8")]
-               (xml/parse istream secure-parser-factory)))))

common/src/app/common/test_helpers/compositions.cljc

@@ -14,7 +14,9 @@
    [app.common.test-helpers.components :as thc]
    [app.common.test-helpers.files :as thf]
    [app.common.test-helpers.shapes :as ths]
-   [app.common.types.container :as ctn]))
+   [app.common.text :as txt]
+   [app.common.types.container :as ctn]
+   [app.common.types.shape :as cts]))
 
 ;; ----- File building
 
@@ -58,6 +60,18 @@
                                     :parent-label frame-label}
                                    child-params))))
 
+(defn add-frame-with-text
+  [file frame-label child-label text & {:keys [frame-params child-params]}]
+  (let [shape (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
+                  (txt/change-text text)
+                  (assoc :position-data nil
+                         :parent-label frame-label))]
+    (-> file
+        (add-frame frame-label frame-params)
+        (ths/add-sample-shape child-label
+                              (merge shape
+                                     child-params)))))
+
 (defn add-minimal-component
   [file component-label root-label
    & {:keys [component-params root-params]}]

common/src/app/common/types/color.cljc

@@ -35,7 +35,7 @@
                        (.. r (toString 16) (padStart 2 "0"))
                        (.. g (toString 16) (padStart 2 "0"))
                        (.. b (toString 16) (padStart 2 "0"))))))
-           sg/any))
+           sg/int))
 
 (defn rgb-color-string?
   [o]
@@ -54,13 +54,13 @@
      ::oapi/type "integer"
      ::oapi/format "int64"}}))
 
-(def schema:image-color
+(def schema:image
   [:map {:title "ImageColor"}
-   [:name {:optional true} :string]
    [:width ::sm/int]
    [:height ::sm/int]
-   [:mtype {:optional true} [:maybe :string]]
+   [:mtype ::sm/text]
    [:id ::sm/uuid]
+   [:name {:optional true} ::sm/text]
    [:keep-aspect-ratio {:optional true} :boolean]])
 
 (def gradient-types
@@ -93,7 +93,7 @@
    [:ref-id {:optional true} ::sm/uuid]
    [:ref-file {:optional true} ::sm/uuid]
    [:gradient {:optional true} [:maybe schema:gradient]]
-   [:image {:optional true} [:maybe schema:image-color]]
+   [:image {:optional true} [:maybe schema:image]]
    [:plugin-data {:optional true} ::ctpg/plugin-data]])
 
 (def schema:color
@@ -106,7 +106,7 @@
     [:opacity {:optional true} [:maybe ::sm/safe-number]]
     [:color {:optional true} [:maybe schema:rgb-color]]
     [:gradient {:optional true} [:maybe schema:gradient]]
-    [:image {:optional true} [:maybe schema:image-color]]]
+    [:image {:optional true} [:maybe schema:image]]]
    [::sm/contains-any {:strict true} [:color :gradient :image]]])
 
 ;; Same as color but with :id prop required
@@ -115,9 +115,10 @@
    (sm/required-keys schema:color-attrs [:id])
    [::sm/contains-any {:strict true} [:color :gradient :image]]])
 
+;; FIXME: revisit if we really need this all registers
 (sm/register! ::color schema:color)
 (sm/register! ::gradient schema:gradient)
-(sm/register! ::image-color schema:image-color)
+(sm/register! ::image-color schema:image)
 (sm/register! ::recent-color schema:recent-color)
 (sm/register! ::color-attrs schema:color-attrs)
 

common/src/app/common/types/container.cljc

@@ -18,8 +18,10 @@
    [app.common.types.plugins :as ctpg]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.layout :as ctl]
+   [app.common.types.text :as cttx]
    [app.common.types.token :as ctt]
-   [app.common.uuid :as uuid]))
+   [app.common.uuid :as uuid]
+   [clojure.set :as set]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMA
@@ -534,8 +536,6 @@
   indicating if shape is touched or not."
   [shape attr val & {:keys [ignore-touched ignore-geometry]}]
   (let [group        (get ctk/sync-attrs attr)
-        token-groups (when (= attr :applied-tokens)
-                       (get-token-groups shape val))
         shape-val    (get shape attr)
 
         ignore?
@@ -566,22 +566,33 @@
           (gsh/close-attrs? attr val shape-val))
 
         touched?
-        (and group (not equal?) (not (and ignore-geometry is-geometry?)))]
+        (and group
+             (not equal?)
+             (not (and ignore-geometry is-geometry?)))
 
+        content-diff-type (when (and (= (:type shape) :text) (= attr :content))
+                            (cttx/get-diff-type (:content shape) val))
+
+        token-groups (if (= attr :applied-tokens)
+                       (get-token-groups shape val)
+                       #{})
+
+        groups (cond-> token-groups
+                 (and group (not equal?))
+                 (set/union #{group} content-diff-type))]
     (cond-> shape
       ;; Depending on the origin of the attribute change, we need or not to
       ;; set the "touched" flag for the group the attribute belongs to.
       ;; In some cases we need to ignore touched only if the attribute is
       ;; geometric (position, width or transformation).
       (and in-copy?
-           (or (and group (not equal?)) (seq token-groups))
-           (not ignore?) (not (and ignore-geometry is-geometry?)))
+           (not-empty groups)
+           (not ignore?)
+           (not (and ignore-geometry is-geometry?)))
       (-> (update :touched (fn [touched]
                              (reduce #(ctk/set-touched-group %1 %2)
                                      touched
-                                     (if group
-                                       (cons group token-groups)
-                                       token-groups))))
+                                     groups)))
           (dissoc :remote-synced))
 
       (nil? val)

common/src/app/common/types/file.cljc

@@ -32,24 +32,31 @@
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CONSTANTS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defonce BASE-FONT-SIZE "16px")
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMA
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema:media
   "A schema that represents the file media object"
-  [:map {:title "FileMediaObject"}
+  [:map {:title "FileMedia"}
    [:id ::sm/uuid]
-   [:created-at ::sm/inst]
+   [:created-at {:optional true} ::sm/inst]
    [:deleted-at {:optional true} ::sm/inst]
    [:name :string]
    [:width ::sm/safe-int]
    [:height ::sm/safe-int]
    [:mtype :string]
-   [:file-id {:optional true} ::sm/uuid]
    [:media-id ::sm/uuid]
+   [:file-id {:optional true} ::sm/uuid]
    [:thumbnail-id {:optional true} ::sm/uuid]
-   [:is-local :boolean]])
+   [:is-local {:optional true} :boolean]])
 
 (def schema:colors
   [:map-of {:gen/max 5} ::sm/uuid ::ctc/color])
@@ -65,7 +72,8 @@
 
 (def schema:options
   [:map {:title "FileOptions"}
-   [:components-v2 {:optional true} ::sm/boolean]])
+   [:components-v2 {:optional true} ::sm/boolean]
+   [:base-font-size {:optional true} :string]])
 
 (def schema:data
   [:map {:title "FileData"}
@@ -102,7 +110,6 @@
 (sm/register! ::media schema:media)
 (sm/register! ::colors schema:colors)
 (sm/register! ::typographies schema:typographies)
-(sm/register! ::media-object schema:media)
 
 (def check-file
   (sm/check-fn schema:file :hint "check error on validating file"))
@@ -110,7 +117,7 @@
 (def check-file-data
   (sm/check-fn schema:data))
 
-(def check-media-object
+(def check-file-media
   (sm/check-fn schema:media))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -134,7 +141,8 @@
        (ctpl/add-page page)
 
        :always
-       (update :options assoc :components-v2 true)))))
+       (update :options merge {:components-v2 true
+                               :base-font-size BASE-FONT-SIZE})))))
 
 (defn make-file
   [{:keys [id project-id name revn is-shared features migrations
@@ -291,7 +299,6 @@
                                  (ctkl/get-component (:data component-file) (:component-id head-shape) include-deleted?))]
             (when (some? component)
               (get-ref-shape (:data component-file) component shape :with-context? with-context?))))]
-
     (some find-ref-shape-in-head (ctn/get-parent-heads (:objects container) shape))))
 
 (defn advance-shape-ref
@@ -1029,3 +1036,14 @@
 
     (-> file
         (update-in [:data :pages-index] detach-pages))))
+
+;; Base font size
+
+(defn get-base-font-size
+  "Retrieve the base font size value or token reference."
+  [file-data]
+  (get-in file-data [:options :base-font-size] BASE-FONT-SIZE))
+
+(defn set-base-font-size
+  [file-data base-font-size]
+  (assoc-in file-data [:options :base-font-size] base-font-size))

common/src/app/common/types/path.cljc

@@ -22,6 +22,14 @@
 
 #?(:clj (set! *warn-on-reflection* true))
 
+(def ^:cosnt bool-group-style-properties bool/group-style-properties)
+(def ^:const bool-style-properties bool/style-properties)
+(def ^:const default-bool-fills bool/default-fills)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TRANSFORMATIONS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn content?
   [o]
   (impl/path-data? o))
@@ -36,6 +44,10 @@
   [data]
   (impl/from-bytes data))
 
+(defn from-string
+  [data]
+  (impl/from-string data))
+
 (defn check-path-content
   [content]
   (impl/check-content-like content))
@@ -193,6 +205,13 @@
   (-> (calc-bool-content* shape objects)
       (impl/path-data)))
 
+(defn update-bool-shape
+  "Calculates the selrect+points for the boolean shape"
+  [shape objects]
+  (let [content (calc-bool-content shape objects)
+        shape   (assoc shape :content content)]
+    (update-geometry shape)))
+
 (defn shape-with-open-path?
   [shape]
   (let [svg? (contains? shape :svg-attrs)

common/src/app/common/types/path/bool.cljc

@@ -18,28 +18,13 @@
 (def default-fills
   [{:fill-color clr/black}])
 
-(def style-group-properties
-  [:shadow :blur])
+(def group-style-properties
+  #{:shadow :blur})
 
+;; FIXME: revisit
 (def style-properties
-  (into style-group-properties
-        [:fill-color
-         :fill-opacity
-         :fill-color-gradient
-         :fill-color-ref-file
-         :fill-color-ref-id
-         :fill-image
-         :fills
-         :stroke-color
-         :stroke-color-ref-file
-         :stroke-color-ref-id
-         :stroke-opacity
-         :stroke-style
-         :stroke-width
-         :stroke-alignment
-         :stroke-cap-start
-         :stroke-cap-end
-         :strokes]))
+  (into group-style-properties
+        [:fills :strokes]))
 
 (defn add-previous
   ([content]

common/src/app/common/types/path/segment.cljc

@@ -54,11 +54,12 @@
                         result)))
                   {})))
 
+;; FIXME: can be optimized with internal reduction
 (defn point-indices
   [content point]
   (->> (d/enumerate content)
        (filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
-       (mapv (fn [[index _]] index))))
+       (map (fn [[index _]] index))))
 
 (defn handler-indices
   "Return an index where the key is the positions and the values the handlers"
@@ -182,11 +183,11 @@
 ;; FIXME: move to helpers?, this function need performance review, it
 ;; is executed so many times on path edition
 (defn- curve-closest-point
-  [position start end h1 h2]
+  [position start end h1 h2 precision]
   (let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
     (loop [t1 0.0
            t2 1.0]
-      (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
+      (if (<= (mth/abs (- t1 t2)) precision)
         (-> (helpers/curve-values start end h1 h2 t1)
             ;; store the segment info
             (with-meta {:t t1 :from-p start :to-p end}))
@@ -214,7 +215,7 @@
                  (double t2)))))))
 
 (defn- line-closest-point
-  "Point on line"
+  "Finds the closest point in the line segment defined by from-p and to-p"
   [position from-p to-p]
 
   (let [e1 (gpt/to-vec from-p to-p)
@@ -235,52 +236,13 @@
         from-p
         to-p))))
 
-;; FIXME: incorrect API, complete shape is not necessary here
-(defn path-closest-point
-  "Given a path and a position"
-  [shape position]
-
-  (let [point+distance
-        (fn [[cur-segment prev-segment]]
-          (let [from-p (helpers/segment->point prev-segment)
-                to-p   (helpers/segment->point cur-segment)
-                h1 (gpt/point (get-in cur-segment [:params :c1x])
-                              (get-in cur-segment [:params :c1y]))
-                h2 (gpt/point (get-in cur-segment [:params :c2x])
-                              (get-in cur-segment [:params :c2y]))
-                point
-                (case (:command cur-segment)
-                  :line-to
-                  (line-closest-point position from-p to-p)
-
-                  :curve-to
-                  (curve-closest-point position from-p to-p h1 h2)
-
-                  nil)]
-            (when point
-              [point (gpt/distance point position)])))
-
-        find-min-point
-        (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
-          (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
-            [min-p min-dist]
-            [cur-p cur-dist]))]
-
-    (->> (:content shape)
-         (d/with-prev)
-         (map point+distance)
-         (reduce find-min-point)
-         (first))))
-
-
 (defn closest-point
-  "Given a path and a position"
-  [content position]
-
+  "Returns the closest point in the path to the position, at a given precision"
+  [content position precision]
   (let [point+distance
         (fn [[cur-segment prev-segment]]
           (let [from-p (helpers/segment->point prev-segment)
-                to-p   (helpers/segment->point cur-segment)
+                to-p (helpers/segment->point cur-segment)
                 h1 (gpt/point (get-in cur-segment [:params :c1x])
                               (get-in cur-segment [:params :c1y]))
                 h2 (gpt/point (get-in cur-segment [:params :c2x])
@@ -291,7 +253,7 @@
                   (line-closest-point position from-p to-p)
 
                   :curve-to
-                  (curve-closest-point position from-p to-p h1 h2)
+                  (curve-closest-point position from-p to-p h1 h2 precision)
 
                   nil)]
             (when point
@@ -311,41 +273,51 @@
 
 (defn- remove-line-curves
   "Remove all curves that have both handlers in the same position that the
-  beginning and end points. This makes them really line-to commands"
-  [content]
-  (let [with-prev (d/enumerate (d/with-prev content))
-        process-command
-        (fn [content [index [command prev]]]
+  beginning and end points. This makes them really line-to commands.
 
-          (let [cur-point (helpers/segment->point command)
+  NOTE: works with plain format so it expects to receive a vector"
+  [content]
+  (assert (vector? content) "expected a plain format for `content`")
+
+  (let [with-prev (d/enumerate (d/with-prev content))
+
+        process-segment
+        (fn [content [index [segment prev]]]
+          (let [cur-point (helpers/segment->point segment)
                 pre-point (helpers/segment->point prev)
-                handler-c1 (get-handler command :c1)
-                handler-c2 (get-handler command :c2)]
-            (if (and (= :curve-to (:command command))
+                handler-c1 (get-handler segment :c1)
+                handler-c2 (get-handler segment :c2)]
+            (if (and (= :curve-to (:command segment))
                      (= cur-point handler-c2)
                      (= pre-point handler-c1))
               (assoc content index {:command :line-to
                                     :params (into {} cur-point)})
               content)))]
 
-    (reduce process-command content with-prev)))
+    (reduce process-segment content with-prev)))
 
 (defn make-corner-point
   "Changes the content to make a point a 'corner'"
   [content point]
-  (let [handlers (-> (get-handlers content)
-                     (get point))
-        change-content
+  (let [handlers
+        (-> (get-handlers content)
+            (get point))
+
+        transform-content
         (fn [content [index prefix]]
           (let [cx (d/prefix-keyword prefix :x)
                 cy (d/prefix-keyword prefix :y)]
             (-> content
                 (assoc-in [index :params cx] (:x point))
-                (assoc-in [index :params cy] (:y point)))))]
-    (as-> content $
-      (reduce change-content $ handlers)
-      (remove-line-curves $))))
+                (assoc-in [index :params cy] (:y point)))))
 
+        content
+        (reduce transform-content (vec content) handlers)
+
+        content
+        (remove-line-curves content)]
+
+    (impl/from-plain content)))
 
 (defn- line->curve
   [from-p segment]
@@ -385,88 +357,118 @@
 
 (def ^:private xf:mapcat-points
   (comp
-   (mapcat #(vector (:next-p %) (:prev-p %)))
+   (mapcat #(list (:next-p %) (:prev-p %)))
    (remove nil?)))
 
 (defn make-curve-point
-  "Changes the content to make the point a 'curve'. The handlers will be positioned
-  in the same vector that results from the previous->next points but with fixed length."
+  "Changes the content to make the point a 'curve'. The handlers will be
+  positioned in the same vector that results from the previous->next
+  points but with fixed length."
   [content point]
 
-  (let [indices (point-indices content point)
-        vectors (map (fn [index]
-                       (let [segment (nth content index)
-                             prev-i (dec index)
-                             prev (when (not (= :move-to (:command segment)))
-                                    (get content prev-i))
-                             next-i (inc index)
-                             next (get content next-i)
+  (let [;; We perform this operation before because it can be
+        ;; optimized with internal reduction so is better to use the
+        ;; PathData type before converting it to plain vector.
+        indices
+        (point-indices content point)
 
-                             next (when (not (= :move-to (:command next)))
-                                    next)]
-                         {:index index
-                          :prev-i (when (some? prev) prev-i)
-                          :prev-c prev
-                          :prev-p (helpers/segment->point prev)
-                          :next-i (when (some? next) next-i)
-                          :next-c next
-                          :next-p (helpers/segment->point next)
-                          :segment segment}))
-                     indices)
+        vectors
+        (map (fn [index]
+               (let [segment (nth content index)
+                     prev-i (dec index)
+                     prev (when (not (= :move-to (:command segment)))
+                            (get content prev-i))
+                     next-i (inc index)
+                     next (get content next-i)
 
-        points (into #{} xf:mapcat-points vectors)]
+                     next (when (not (= :move-to (:command next)))
+                            next)]
+                 {:index index
+                  :prev-i (when (some? prev) prev-i)
+                  :prev-c prev
+                  :prev-p (helpers/segment->point prev)
+                  :next-i (when (some? next) next-i)
+                  :next-c next
+                  :next-p (helpers/segment->point next)
+                  :segment segment}))
+             indices)
 
-    (if (= (count points) 2)
-      (let [v1 (gpt/to-vec (first points) point)
-            v2 (gpt/to-vec (first points) (second points))
-            vp (gpt/project v1 v2)
-            vh (gpt/subtract v1 vp)
+        points
+        (into #{} xf:mapcat-points vectors)
 
-            add-curve
-            (fn [content {:keys [index prev-p next-p next-i]}]
-              (let [cur-segment (get content index)
-                    next-segment (get content next-i)
+        ;; We transform content to a plain format for execute the
+        ;; algorithm because right now is the only way to execute it
+        content
+        (vec content)
 
-                    ;; New handlers for prev-point and next-point
-                    prev-h (when (some? prev-p) (gpt/add prev-p vh))
-                    next-h (when (some? next-p) (gpt/add next-p vh))
+        content
+        (if (= (count points) 2)
+          (let [[fpoint spoint] (vec points)
+                v1 (gpt/to-vec fpoint point)
+                v2 (gpt/to-vec fpoint spoint)
+                vp (gpt/project v1 v2)
+                vh (gpt/subtract v1 vp)
 
-                    ;; Correct 1/3 to the point improves the curve
-                    prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
-                    next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
+                add-curve
+                (fn [content {:keys [index prev-p next-p next-i]}]
+                  (let [curr-segment (get content index)
+                        curr-command (get curr-segment :command)
 
-                    prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
-                    next-h (when (some? next-h) (gpt/add next-h next-correction))]
-                (cond-> content
-                  (and (= :line-to (:command cur-segment)) (some? prev-p))
-                  (update index helpers/update-curve-to prev-p prev-h)
+                        next-segment (get content next-i)
+                        next-command (get next-segment :command)
 
-                  (and (= :line-to (:command next-segment)) (some? next-p))
-                  (update next-i helpers/update-curve-to next-h next-p)
+                        ;; New handlers for prev-point and next-point
+                        prev-h
+                        (when (some? prev-p) (gpt/add prev-p vh))
 
-                  (and (= :curve-to (:command cur-segment)) (some? prev-p))
-                  (update index update-handler :c2 prev-h)
+                        next-h
+                        (when (some? next-p) (gpt/add next-p vh))
 
-                  (and (= :curve-to (:command next-segment)) (some? next-p))
-                  (update next-i update-handler :c1 next-h))))]
+                        ;; Correct 1/3 to the point improves the curve
+                        prev-correction
+                        (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
 
-        (reduce add-curve content vectors))
+                        next-correction
+                        (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
 
-      (let [add-curve
-            (fn [content {:keys [index segment prev-p next-c next-i]}]
-              (cond-> content
-                (= :line-to (:command segment))
-                (update index #(line->curve prev-p %))
+                        prev-h
+                        (when (some? prev-h) (gpt/add prev-h prev-correction))
 
-                (= :curve-to (:command segment))
-                (update index #(line->curve prev-p %))
+                        next-h
+                        (when (some? next-h) (gpt/add next-h next-correction))]
 
-                (= :line-to (:command next-c))
-                (update next-i #(line->curve point %))
+                    (cond-> content
+                      (and (= :line-to curr-command) (some? prev-p))
+                      (update index helpers/update-curve-to prev-p prev-h)
 
-                (= :curve-to (:command next-c))
-                (update next-i #(line->curve point %))))]
-        (reduce add-curve content vectors)))))
+                      (and (= :line-to next-command) (some? next-p))
+                      (update next-i helpers/update-curve-to next-h next-p)
+
+                      (and (= :curve-to curr-command) (some? prev-p))
+                      (update index update-handler :c2 prev-h)
+
+                      (and (= :curve-to next-command) (some? next-p))
+                      (update next-i update-handler :c1 next-h))))]
+
+            (reduce add-curve content vectors))
+
+          (let [add-curve
+                (fn [content {:keys [index segment prev-p next-c next-i]}]
+                  (cond-> content
+                    (= :line-to (:command segment))
+                    (update index #(line->curve prev-p %))
+
+                    (= :curve-to (:command segment))
+                    (update index #(line->curve prev-p %))
+
+                    (= :line-to (:command next-c))
+                    (update next-i #(line->curve point %))
+
+                    (= :curve-to (:command next-c))
+                    (update next-i #(line->curve point %))))]
+            (reduce add-curve content vectors)))]
+
+    (impl/from-plain content)))
 
 (defn get-segments-with-points
   "Given a content and a set of points return all the segments in the path

common/src/app/common/types/shape.cljc

@@ -761,3 +761,8 @@
         (d/patch-object (select-keys props basic-extract-props))
         (cond-> (cfh/text-shape? shape) (patch-text-props props))
         (cond-> (cfh/frame-shape? shape) (patch-layout-props props)))))
+
+;; FIXME: Get these from the wasm module, and tweak the values
+;; (we'd probably want 12 stops at most)
+(def MAX-GRADIENT-STOPS 16)
+(def MAX-FILLS 8)

common/src/app/common/types/shape/text.cljc

@@ -16,54 +16,56 @@
 
 (def node-types #{"root" "paragraph-set" "paragraph"})
 
-(sm/register!
- ^{::sm/type ::content}
- [:map
-  [:type [:= "root"]]
-  [:key {:optional true} :string]
-  [:children
-   {:optional true}
-   [:maybe
-    [:vector {:min 1 :gen/max 2 :gen/min 1}
-     [:map
-      [:type [:= "paragraph-set"]]
-      [:key {:optional true} :string]
-      [:children
-       [:vector {:min 1 :gen/max 2 :gen/min 1}
-        [:map
-         [:type [:= "paragraph"]]
-         [:key {:optional true} :string]
-         [:fills {:optional true}
-          [:maybe
-           [:vector {:gen/max 2} ::shape/fill]]]
-         [:font-family {:optional true} :string]
-         [:font-size {:optional true} :string]
-         [:font-style {:optional true} :string]
-         [:font-weight {:optional true} :string]
-         [:direction {:optional true} :string]
-         [:text-decoration {:optional true} :string]
-         [:text-transform {:optional true} :string]
-         [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
-         [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
-         [:children
-          [:vector {:min 1 :gen/max 2 :gen/min 1}
-           [:map
-            [:text :string]
-            [:key {:optional true} :string]
-            [:fills {:optional true}
-             [:maybe
-              [:vector {:gen/max 2} ::shape/fill]]]
-            [:font-family {:optional true} :string]
-            [:font-size {:optional true} :string]
-            [:font-style {:optional true} :string]
-            [:font-weight {:optional true} :string]
-            [:direction {:optional true} :string]
-            [:text-decoration {:optional true} :string]
-            [:text-transform {:optional true} :string]
-            [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
-            [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
+(def schema:content
+  [:map
+   [:type [:= "root"]]
+   [:key {:optional true} :string]
+   [:children
+    {:optional true}
+    [:maybe
+     [:vector {:min 1 :gen/max 2 :gen/min 1}
+      [:map
+       [:type [:= "paragraph-set"]]
+       [:key {:optional true} :string]
+       [:children
+        [:vector {:min 1 :gen/max 2 :gen/min 1}
+         [:map
+          [:type [:= "paragraph"]]
+          [:key {:optional true} :string]
+          [:fills {:optional true}
+           [:maybe
+            [:vector {:gen/max 2} ::shape/fill]]]
+          [:font-family {:optional true} :string]
+          [:font-size {:optional true} :string]
+          [:font-style {:optional true} :string]
+          [:font-weight {:optional true} :string]
+          [:direction {:optional true} :string]
+          [:text-decoration {:optional true} :string]
+          [:text-transform {:optional true} :string]
+          [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
+          [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
+          [:children
+           [:vector {:min 1 :gen/max 2 :gen/min 1}
+            [:map
+             [:text :string]
+             [:key {:optional true} :string]
+             [:fills {:optional true}
+              [:maybe
+               [:vector {:gen/max 2} ::shape/fill]]]
+             [:font-family {:optional true} :string]
+             [:font-size {:optional true} :string]
+             [:font-style {:optional true} :string]
+             [:font-weight {:optional true} :string]
+             [:direction {:optional true} :string]
+             [:text-decoration {:optional true} :string]
+             [:text-transform {:optional true} :string]
+             [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
+             [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
 
+(sm/register! ::content schema:content)
 
+(def valid-content?
+  (sm/lazy-validator schema:content))
 
 (sm/register!
  ^{::sm/type ::position-data}

common/src/app/common/types/text.cljc

@@ -0,0 +1,144 @@
+;; 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.common.types.text
+   (:require
+    [app.common.data.macros :as dm]
+    [clojure.set :as set]))
+
+(defn- compare-text-content
+  "Given two content text structures, conformed by maps and vectors,
+   compare them, and returns a set with the type of differences.
+   The possibilities are :text-content-text :text-content-attribute and :text-content-structure."
+  [a b]
+  (cond
+    ;; If a and b are equal, there is no diff
+    (= a b)
+    #{}
+
+    ;; If types are different, the structure is different
+    (not= (type a) (type b))
+    #{:text-content-structure}
+
+    ;; If they are maps, check the keys
+    (map? a)
+    (let [keys (-> (set/union (set (keys a)) (set (keys b)))
+                   (disj :key))] ;; We have to ignore :key because it is a draft artifact
+      (reduce
+       (fn [acc k]
+         (let [v1 (get a k)
+               v2 (get b k)]
+           (cond
+             ;; If the key is :children, keep digging
+             (= k :children)
+             (if (not= (count v1) (count v2))
+               #{:text-content-structure}
+               (into acc
+                     (apply set/union
+                            (map #(compare-text-content %1 %2) v1 v2))))
+
+             ;; If the key is :text, and they are different, it is a text differece
+             (= k :text)
+             (if (not= v1 v2)
+               (conj acc :text-content-text)
+               acc)
+
+             :else
+             ;; If the key is not :text, and they are different, it is an attribute differece
+             (if (not= v1 v2)
+               (conj acc :text-content-attribute)
+               acc))))
+       #{}
+       keys))
+
+    :else
+    #{:text-content-structure}))
+
+
+(defn equal-attrs?
+  "Given a text structure, and a map of attrs, check that all the internal attrs in
+   paragraphs and sentences have the same attrs"
+  [item attrs]
+  (let [item-attrs (dissoc item :text :type :key :children)]
+    (and
+     (or (empty? item-attrs)
+         (= attrs (dissoc item :text :type :key :children)))
+     (every? #(equal-attrs? % attrs) (:children item)))))
+
+(defn get-first-paragraph-text-attrs
+  "Given a content text structure, extract it's first paragraph
+   text attrs"
+  [content]
+  (-> content
+      (dm/get-in [:children 0 :children 0])
+      (dissoc :text :type :key :children)))
+
+(defn get-diff-type
+  "Given two content text structures, conformed by maps and vectors,
+   compare them, and returns a set with the type of differences.
+   The possibilities are :text-content-text :text-content-attribute,
+   :text-content-structure and :text-content-structure-same-attrs."
+  [a b]
+  (let [diff-type (compare-text-content a b)]
+    (if-not (contains? diff-type :text-content-structure)
+      diff-type
+      (let [;; get attrs of the first paragraph of the first paragraph-set
+            attrs (get-first-paragraph-text-attrs a)]
+        (if (and (equal-attrs? a attrs)
+                 (equal-attrs? b attrs))
+          #{:text-content-structure :text-content-structure-same-attrs}
+          diff-type)))))
+
+;; TODO We know that there are cases that the blocks of texts are separated
+;; differently: ["one" " " "two"], ["one " "two"], ["one" " two"]
+;; so this won't work for 100% of the situations. But it's good enough for now,
+;; we can iterate on the solution again in the future if needed.
+(defn equal-structure?
+  "Given two content text structures, check that the structures are equal.
+   This means that all the :children keys at any level has the same number of
+   entries"
+  [a b]
+  (cond
+    (not= (type a) (type b))
+    false
+
+    (map? a)
+    (let [children-a (:children a)
+          children-b (:children b)]
+      (if (not= (count children-a) (count children-b))
+        false
+        (every? true?
+                (map equal-structure? children-a children-b))))
+
+    :else
+    true))
+
+
+(defn copy-text-keys
+  "Given two equal content text structures, deep copy all the keys :text
+   from origin to destiny"
+  [origin destiny]
+  (cond
+    (map? origin)
+    (into {}
+          (for [k (keys origin) :when (not= k :key)] ;; We ignore :key because it is a draft artifact
+            (cond
+              (= :children k)
+              [k (vec (map #(copy-text-keys %1 %2) (get origin k) (get destiny k)))]
+              (= :text k)
+              [k (:text origin)]
+              :else
+              [k (get destiny k)])))))
+
+(defn copy-attrs-keys
+  "Given a content text structure and a list of attrs, copy that
+   attrs values on all the content tree"
+  [content attrs]
+  (into {}
+        (for [[k v] content]
+          (if (= :children k)
+            [k (vec (map #(copy-attrs-keys %1 attrs) v))]
+            [k (get attrs k v)]))))

common/src/app/common/types/tokens_lib.cljc

@@ -7,6 +7,7 @@
 (ns app.common.types.tokens-lib
   (:require
    #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as json])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
@@ -118,7 +119,7 @@
   [:map {:title "Token"}
    [:name cto/token-name-ref]
    [:type [::sm/one-of cto/token-types]]
-   [:value :any]
+   [:value ::sm/any]
    [:description {:optional true} :string]
    [:modified-at {:optional true} ::sm/inst]])
 
@@ -389,7 +390,8 @@
    [:description {:optional true} :string]
    [:modified-at {:optional true} ::sm/inst]
    [:tokens {:optional true
-             :gen/gen (->> (sg/generator [:map-of ::sm/text schema:token])
+             :gen/gen (->> (sg/map-of (sg/generator ::sm/text)
+                                      (sg/generator schema:token))
                            (sg/fmap #(into (d/ordered-map) %)))}
     [:and
      [:map-of {:gen/max 5
@@ -660,63 +662,6 @@
 (def valid-active-token-themes?
   (sm/validator schema:active-themes))
 
-;; === Import / Export from DTCG format
-
-(def ^:private legacy-node?
-  (sm/validator
-   [:or
-    [:map
-     ["value" :string]
-     ["type" :string]]
-    [:map
-     ["value" [:sequential [:map ["type" :string]]]]
-     ["type" :string]]
-    [:map
-     ["value" :map]
-     ["type" :string]]]))
-
-(def ^:private dtcg-node?
-  (sm/validator
-   [:or
-    [:map
-     ["$value" :string]
-     ["$type" :string]]
-    [:map
-     ["$value" [:sequential [:map ["$type" :string]]]]
-     ["$type" :string]]
-    [:map
-     ["$value" :map]
-     ["$type" :string]]]))
-
-(defn get-json-format
-  "Searches through parsed token file and returns:
-   - `:json-format/legacy` when first node satisfies `legacy-node?` predicate
-   - `:json-format/dtcg` when first node satisfies `dtcg-node?` predicate
-   - `nil` if neither combination is found"
-  ([data]
-   (get-json-format data legacy-node? dtcg-node?))
-  ([data legacy-node? dtcg-node?]
-   (let [branch? map?
-         children (fn [node] (vals node))
-         check-node (fn [node]
-                      (cond
-                        (legacy-node? node) :json-format/legacy
-                        (dtcg-node? node) :json-format/dtcg
-                        :else nil))
-         walk (fn walk [node]
-                (lazy-seq
-                 (cons
-                  (check-node node)
-                  (when (branch? node)
-                    (mapcat walk (children node))))))]
-     (->> (walk data)
-          (filter some?)
-          first))))
-
-(defn single-set? [data]
-  (and (not (contains? data "$metadata"))
-       (not (contains? data "$themes"))))
-
 ;; DEPRECATED
 (defn walk-sets-tree-seq
   "Walk sets tree as a flat list.
@@ -826,51 +771,10 @@
          (map-indexed (fn [index item]
                         (assoc item :index index))))))
 
-(defn flatten-nested-tokens-json
-  "Recursively flatten the dtcg token structure, joining keys with '.'."
-  [tokens token-path]
-  (reduce-kv
-   (fn [acc k v]
-     (let [child-path (if (empty? token-path)
-                        (name k)
-                        (str token-path "." k))]
-       (if (and (map? v)
-                (not (contains? v "$type")))
-         (merge acc (flatten-nested-tokens-json v child-path))
-         (let [token-type (cto/dtcg-token-type->token-type (get v "$type"))]
-           (if token-type
-             (assoc acc child-path (make-token
-                                    :name child-path
-                                    :type token-type
-                                    :value (get v "$value")
-                                    :description (get v "$description")))
-             ;; Discard unknown tokens
-             acc)))))
-   {}
-   tokens))
-
 ;; === Tokens Lib
 
 (declare make-tokens-lib)
 
-(defn legacy-nodes->dtcg-nodes [sets-data]
-  (walk/postwalk
-   (fn [node]
-     (cond-> node
-       (and (map? node)
-            (contains? node "value")
-            (sequential? (get node "value")))
-       (update "value"
-               (fn [seq-value]
-                 (map #(set/rename-keys % {"type" "$type"}) seq-value)))
-
-       (and (map? node)
-            (and (contains? node "type")
-                 (contains? node "value")))
-       (set/rename-keys  {"value" "$value"
-                          "type" "$type"})))
-   sets-data))
-
 (defprotocol ITokensLib
   "A library of tokens, sets and themes."
   (set-path-exists? [_ path] "if a set at `path` exists")
@@ -887,12 +791,11 @@ Will return a value that matches this schema:
 `:all`     All of the nested sets are active
 `:partial` Mixed active state of nested sets")
   (get-active-themes-set-tokens [_] "set of set names that are active in the the active themes")
-  (encode-dtcg [_] "Encodes library to a dtcg compatible json string")
-  (decode-dtcg-json [_ parsed-json] "Decodes parsed json containing tokens and converts to library")
-  (decode-legacy-json [_ parsed-json] "Decodes parsed legacy json containing tokens and converts to library")
   (get-all-tokens [_] "all tokens in the lib")
   (validate [_]))
 
+(declare parse-multi-set-dtcg-json)
+(declare export-dtcg-json)
 (deftype TokensLib [sets themes active-themes]
   ;; NOTE: This is only for debug purposes, pending to properly
   ;; implement the toString and alternative printing.
@@ -909,6 +812,9 @@ Will return a value that matches this schema:
              (-clj->js [_] (js-obj "sets" (clj->js sets)
                                    "themes" (clj->js themes)
                                    "active-themes" (clj->js active-themes)))])
+  #?@(:clj
+      [json/JSONWriter
+       (-write [this writter options] (json/-write (export-dtcg-json this) writter options))])
 
   ITokenSets
   (add-set [_ token-set]
@@ -1283,142 +1189,6 @@ Will return a value that matches this schema:
                                    active-set-names)]
       tokens))
 
-  (encode-dtcg [this]
-    (let [themes-xform
-          (comp
-           (filter #(and (instance? TokenTheme %)
-                         (not (hidden-temporary-theme? %))))
-           (map (fn [token-theme]
-                  (let [theme-map (->> token-theme
-                                       (into {})
-                                       walk/stringify-keys)]
-                    (-> theme-map
-                        (set/rename-keys  {"sets" "selectedTokenSets"})
-                        (update "selectedTokenSets" (fn [sets]
-                                                      (->> (for [s sets] [s "enabled"])
-                                                           (into {})))))))))
-          themes
-          (->> (tree-seq d/ordered-map? vals themes)
-               (into [] themes-xform))
-
-          ;; Active themes without exposing hidden penpot theme
-          active-themes-clear
-          (disj active-themes hidden-token-theme-path)
-
-          update-token-fn
-          (fn [token]
-            (cond-> {"$value" (:value token)
-                     "$type" (cto/token-type->dtcg-token-type (:type token))}
-              (:description token) (assoc "$description" (:description token))))
-
-          name-set-tuples
-          (->> sets
-               (tree-seq d/ordered-map? vals)
-               (filter (partial instance? TokenSet))
-               (map (fn [{:keys [name tokens]}]
-                      [name (tokens-tree tokens :update-token-fn update-token-fn)])))
-
-          ordered-set-names
-          (mapv first name-set-tuples)
-
-          sets
-          (into {} name-set-tuples)
-
-          active-sets
-          (get-active-themes-set-names this)]
-
-      (-> sets
-          (assoc "$themes" themes)
-          (assoc-in ["$metadata" "tokenSetOrder"] ordered-set-names)
-          (assoc-in ["$metadata" "activeThemes"] active-themes-clear)
-          (assoc-in ["$metadata" "activeSets"] active-sets))))
-
-  (decode-dtcg-json [_ data]
-    (assert (map? data) "expected a map data structure for `data`")
-
-    (let [metadata (get data "$metadata")
-
-          xf-normalize-set-name
-          (map normalize-set-name)
-
-          sets
-          (dissoc data "$themes" "$metadata")
-
-          ordered-sets
-          (-> (d/ordered-set)
-              (into xf-normalize-set-name (get metadata "tokenSetOrder"))
-              (into xf-normalize-set-name (keys sets)))
-
-          active-sets
-          (or (->> (get metadata "activeSets")
-                   (into #{} xf-normalize-set-name)
-                   (not-empty))
-              #{})
-
-          active-themes
-          (or (->> (get metadata "activeThemes")
-                   (into #{})
-                   (not-empty))
-              #{hidden-token-theme-path})
-
-          themes
-          (->> (get data "$themes")
-               (map (fn [theme]
-                      (make-token-theme
-                       :name (get theme "name")
-                       :group (get theme "group")
-                       :is-source (get theme "is-source")
-                       :id (get theme "id")
-                       :modified-at (some-> (get theme "modified-at")
-                                            (dt/parse-instant))
-                       :sets (into #{}
-                                   (comp (map key)
-                                         xf-normalize-set-name
-                                         (filter #(contains? ordered-sets %)))
-                                   (get theme "selectedTokenSets")))))
-               (not-empty))
-
-          library
-          (make-tokens-lib)
-
-          sets
-          (reduce-kv (fn [result name tokens]
-                       (assoc result
-                              (normalize-set-name name)
-                              (flatten-nested-tokens-json tokens "")))
-                     {}
-                     sets)
-
-          library
-          (reduce (fn [library name]
-                    (if-let [tokens (get sets name)]
-                      (add-set library (make-token-set :name name :tokens tokens))
-                      library))
-                  library
-                  ordered-sets)
-
-          library
-          (update-theme library hidden-token-theme-group hidden-token-theme-name
-                        #(assoc % :sets active-sets))
-
-          library
-          (reduce add-theme library themes)
-
-          library
-          (reduce (fn [library theme-path]
-                    (let [[group name] (split-token-theme-path theme-path)]
-                      (activate-theme library group name)))
-                  library
-                  active-themes)]
-
-      library))
-
-  (decode-legacy-json [this parsed-legacy-json]
-    (let [other-data (select-keys parsed-legacy-json ["$themes" "$metadata"])
-          sets-data (dissoc parsed-legacy-json "$themes" "$metadata")
-          dtcg-sets-data (legacy-nodes->dtcg-nodes sets-data)]
-      (decode-dtcg-json this (merge other-data
-                                    dtcg-sets-data))))
   (get-all-tokens [this]
     (reduce
      (fn [tokens' set]
@@ -1480,17 +1250,13 @@ Will return a value that matches this schema:
   [tokens-lib]
   (or tokens-lib (make-tokens-lib)))
 
-(defn decode-dtcg
-  [encoded-json]
-  (-> (make-tokens-lib)
-      (decode-dtcg-json encoded-json)))
-
-(def type:tokens-lib
-  {:type ::tokens-lib
-   :pred valid-tokens-lib?
-   :type-properties
-   {:encode/json encode-dtcg
-    :decode/json decode-dtcg}})
+(def schema:tokens-lib
+  (sm/register!
+   {:type ::tokens-lib
+    :pred valid-tokens-lib?
+    :type-properties
+    {:encode/json export-dtcg-json
+     :decode/json parse-multi-set-dtcg-json}}))
 
 (defn duplicate-set [set-name lib & {:keys [suffix]}]
   (let [sets (get-sets lib)
@@ -1500,7 +1266,335 @@ Will return a value that matches this schema:
             (assoc :name copy-name)
             (assoc :modified-at (dt/now)))))
 
-(sm/register! type:tokens-lib)
+;; === Import / Export from JSON format
+
+;; Supported formats:
+;;  - Legacy: for tokens files prior to DTCG second draft
+;;  - DTCG: for tokens files conforming to the DTCG second draft (current for now)
+;;    https://www.w3.org/community/design-tokens/2022/06/14/call-to-implement-the-second-editors-draft-and-share-feedback/
+;;
+;;  - Single set: for files that comply with the base DTCG format, that contain a single tree of tokens.
+;;  - Multi sets: for files with the Tokens Studio extension, that may contain several sets, and also themes and other $metadata.
+;;
+;; Small glossary:
+;;  * json data: a json-encoded string
+;;  * decode: convert a json string into a plain clojure nested map
+;;  * parse: build a TokensLib (or a fragment) from a decoded json data
+;;  * export: generate from a TokensLib a plain clojure nested map, suitable to be encoded as a json string
+
+(def ^:private legacy-node?
+  (sm/validator
+   [:or
+    [:map
+     ["value" :string]
+     ["type" :string]]
+    [:map
+     ["value" [:sequential [:map ["type" :string]]]]
+     ["type" :string]]
+    [:map
+     ["value" :map]
+     ["type" :string]]]))
+
+(def ^:private dtcg-node?
+  (sm/validator
+   [:or
+    [:map
+     ["$value" :string]
+     ["$type" :string]]
+    [:map
+     ["$value" [:sequential [:map ["$type" :string]]]]
+     ["$type" :string]]
+    [:map
+     ["$value" :map]
+     ["$type" :string]]]))
+
+(defn- get-json-format
+  "Searches through decoded token file and returns:
+   - `:json-format/legacy` when first node satisfies `legacy-node?` predicate
+   - `:json-format/dtcg` when first node satisfies `dtcg-node?` predicate
+   - `nil` if neither combination is found"
+  ([decoded-json]
+   (get-json-format decoded-json legacy-node? dtcg-node?))
+  ([decoded-json legacy-node? dtcg-node?]
+   (assert (map? decoded-json) "expected a plain clojure map for `decoded-json`")
+   (let [branch? map?
+         children (fn [node] (vals node))
+         check-node (fn [node]
+                      (cond
+                        (legacy-node? node) :json-format/legacy
+                        (dtcg-node? node) :json-format/dtcg
+                        :else nil))
+         walk (fn walk [node]
+                (lazy-seq
+                 (cons
+                  (check-node node)
+                  (when (branch? node)
+                    (mapcat walk (children node))))))]
+     (->> (walk decoded-json)
+          (filter some?)
+          first)))) ;; TODO: throw error if format cannot be determined
+
+(defn- legacy-json->dtcg-json
+  "Converts a decoded json file in legacy format into DTCG format."
+  [decoded-json]
+  (assert (map? decoded-json) "expected a plain clojure map for `decoded-json`")
+  (walk/postwalk
+   (fn [node]
+     (cond-> node
+       (and (map? node)
+            (contains? node "value")
+            (sequential? (get node "value")))
+       (update "value"
+               (fn [seq-value]
+                 (map #(set/rename-keys % {"type" "$type"}) seq-value)))
+
+       (and (map? node)
+            (and (contains? node "type")
+                 (contains? node "value")))
+       (set/rename-keys  {"value" "$value"
+                          "type" "$type"})))
+   decoded-json))
+
+(defn- single-set?
+  "Check if the decoded json file conforms to basic DTCG format with a single set."
+  [decoded-json]
+  (assert (map? decoded-json) "expected a plain clojure map for `decoded-json`")
+  (and (not (contains? decoded-json "$metadata"))
+       (not (contains? decoded-json "$themes"))))
+
+(defn- flatten-nested-tokens-json
+  "Convert a tokens tree in the decoded json fragment into a flat map,
+   being the keys the token paths after joining the keys with '.'."
+  [decoded-json-tokens parent-path]
+  (reduce-kv
+   (fn [tokens k v]
+     (let [child-path (if (empty? parent-path)
+                        (name k)
+                        (str parent-path "." k))]
+       (if (and (map? v)
+                (not (contains? v "$type")))
+         (merge tokens (flatten-nested-tokens-json v child-path))
+         (let [token-type (cto/dtcg-token-type->token-type (get v "$type"))]
+           (if token-type
+             (assoc tokens child-path (make-token
+                                       :name child-path
+                                       :type token-type
+                                       :value (get v "$value")
+                                       :description (get v "$description")))
+             ;; Discard unknown type tokens
+             tokens)))))
+   {}
+   decoded-json-tokens))
+
+(defn- parse-single-set-dtcg-json
+  "Parse a decoded json file with a single set of tokens in DTCG format into a TokensLib."
+  [set-name decoded-json-tokens]
+  (assert (map? decoded-json-tokens) "expected a plain clojure map for `decoded-json-tokens`")
+  (assert (= (get-json-format decoded-json-tokens) :json-format/dtcg) "expected a dtcg format for `decoded-json-tokens`")
+  (-> (make-tokens-lib)
+      (add-set (make-token-set :name (normalize-set-name set-name)
+                               :tokens (flatten-nested-tokens-json decoded-json-tokens "")))))
+
+(defn- parse-single-set-legacy-json
+  "Parse a decoded json file with a single set of tokens in legacy format into a TokensLib."
+  [set-name decoded-json-tokens]
+  (assert (map? decoded-json-tokens) "expected a plain clojure map for `decoded-json-tokens`")
+  (assert (= (get-json-format decoded-json-tokens) :json-format/legacy) "expected a legacy format for `decoded-json-tokens`")
+  (parse-single-set-dtcg-json set-name (legacy-json->dtcg-json decoded-json-tokens)))
+
+(defn- parse-multi-set-dtcg-json
+  "Parse a decoded json file with multi sets in DTCG format into a TokensLib."
+  [decoded-json]
+  (assert (map? decoded-json) "expected a plain clojure map for `decoded-json`")
+  (assert (= (get-json-format decoded-json) :json-format/dtcg) "expected a dtcg format for `decoded-json`")
+
+  (let [metadata (get decoded-json "$metadata")
+
+        xf-normalize-set-name
+        (map normalize-set-name)
+
+        sets
+        (dissoc decoded-json "$themes" "$metadata")
+
+        ordered-set-names
+        (-> (d/ordered-set)
+            (into xf-normalize-set-name (get metadata "tokenSetOrder"))
+            (into xf-normalize-set-name (keys sets)))
+
+        active-set-names
+        (or (->> (get metadata "activeSets")
+                 (into #{} xf-normalize-set-name)
+                 (not-empty))
+            #{})
+
+        active-theme-names
+        (or (->> (get metadata "activeThemes")
+                 (into #{})
+                 (not-empty))
+            #{hidden-token-theme-path})
+
+        themes
+        (->> (get decoded-json "$themes")
+             (map (fn [theme]
+                    (make-token-theme
+                     :name (get theme "name")
+                     :group (get theme "group")
+                     :is-source (get theme "is-source")
+                     :id (get theme "id")
+                     :modified-at (some-> (get theme "modified-at")
+                                          (dt/parse-instant))
+                     :sets (into #{}
+                                 (comp (map key)
+                                       xf-normalize-set-name
+                                       (filter #(contains? ordered-set-names %)))
+                                 (get theme "selectedTokenSets")))))
+             (not-empty))
+
+        library
+        (make-tokens-lib)
+
+        sets
+        (reduce-kv (fn [result name tokens]
+                     (assoc result
+                            (normalize-set-name name)
+                            (flatten-nested-tokens-json tokens "")))
+                   {}
+                   sets)
+
+        library
+        (reduce (fn [library name]
+                  (if-let [tokens (get sets name)]
+                    (add-set library (make-token-set :name name :tokens tokens))
+                    library))
+                library
+                ordered-set-names)
+
+        library
+        (update-theme library hidden-token-theme-group hidden-token-theme-name
+                      #(assoc % :sets active-set-names))
+
+        library
+        (reduce add-theme library themes)
+
+        library
+        (reduce (fn [library theme-path]
+                  (let [[group name] (split-token-theme-path theme-path)]
+                    (activate-theme library group name)))
+                library
+                active-theme-names)]
+
+    library))
+
+(defn- parse-multi-set-legacy-json
+  "Parse a decoded json file with multi sets in legacy format into a TokensLib."
+  [decoded-json]
+  (assert (map? decoded-json) "expected a plain clojure map for `decoded-json`")
+  (assert (= (get-json-format decoded-json) :json-format/legacy) "expected a legacy format for `decoded-json`")
+
+  (let [sets-data      (dissoc decoded-json "$themes" "$metadata")
+        other-data     (select-keys decoded-json ["$themes" "$metadata"])
+        dtcg-sets-data (legacy-json->dtcg-json sets-data)]
+    (parse-multi-set-dtcg-json (merge other-data
+                                      dtcg-sets-data))))
+
+(defn parse-decoded-json
+  "Guess the format and content type of the decoded json file and parse it into a TokensLib.
+   The `file-name` is used to determine the set name when the json file contains a single set."
+  [decoded-json file-name]
+  (let [single-set? (single-set? decoded-json)
+        json-format (get-json-format decoded-json)]
+    (cond
+      (and single-set?
+           (= :json-format/legacy json-format))
+      (parse-single-set-legacy-json file-name decoded-json)
+
+      (and single-set?
+           (= :json-format/dtcg json-format))
+      (parse-single-set-dtcg-json file-name decoded-json)
+
+      (= :json-format/legacy json-format)
+      (parse-multi-set-legacy-json decoded-json)
+
+      :else
+      (parse-multi-set-dtcg-json decoded-json))))
+
+(defn export-dtcg-json
+  "Convert a TokensLib into a plain clojure map, suitable to be encoded as a multi sets json string in DTCG format."
+  [tokens-lib]
+  (let [themes-xform
+        (comp
+         (filter #(and (instance? TokenTheme %)
+                       (not (hidden-temporary-theme? %))))
+         (map (fn [token-theme]
+                (let [theme-map (->> token-theme
+                                     (into {})
+                                     walk/stringify-keys)]
+                  (-> theme-map
+                      (set/rename-keys  {"sets" "selectedTokenSets"})
+                      (update "selectedTokenSets" (fn [sets]
+                                                    (->> (for [s sets] [s "enabled"])
+                                                         (into {})))))))))
+        themes
+        (->> (get-theme-tree tokens-lib)
+             (tree-seq d/ordered-map? vals)
+             (into [] themes-xform))
+
+          ;; Active themes without exposing hidden penpot theme
+        active-themes-clear
+        (-> (get-active-theme-paths tokens-lib)
+            (disj hidden-token-theme-path))
+
+        update-token-fn
+        (fn [token]
+          (cond-> {"$value" (:value token)
+                   "$type" (cto/token-type->dtcg-token-type (:type token))}
+            (:description token) (assoc "$description" (:description token))))
+
+        name-set-tuples
+        (->> (get-set-tree tokens-lib)
+             (tree-seq d/ordered-map? vals)
+             (filter (partial instance? TokenSet))
+             (map (fn [{:keys [name tokens]}]
+                    [name (tokens-tree tokens :update-token-fn update-token-fn)])))
+
+        ordered-set-names
+        (mapv first name-set-tuples)
+
+        sets
+        (into {} name-set-tuples)
+
+        active-set-names
+        (get-active-themes-set-names tokens-lib)]
+
+    (-> sets
+        (assoc "$themes" themes)
+        (assoc-in ["$metadata" "tokenSetOrder"] ordered-set-names)
+        (assoc-in ["$metadata" "activeThemes"] active-themes-clear)
+        (assoc-in ["$metadata" "activeSets"] active-set-names))))
+
+(defn get-tokens-of-unknown-type
+  "Search for all tokens in the decoded json file that have a type that is not currently
+   supported by Penpot. Returns a map token-path -> token type."
+  ([decoded-json]
+   (get-tokens-of-unknown-type decoded-json "" (get-json-format decoded-json)))
+  ([decoded-json parent-path json-format]
+   (let [type-key (if (= json-format :json-format/dtcg) "$type" "type")]
+     (reduce-kv
+      (fn [unknown-tokens k v]
+        (let [child-path (if (empty? parent-path)
+                           (name k)
+                           (str parent-path "." k))]
+          (if (and (map? v)
+                   (not (contains? v type-key)))
+            (let [nested-unknown-tokens (get-tokens-of-unknown-type v child-path json-format)]
+              (merge unknown-tokens nested-unknown-tokens))
+            (let [token-type-str (get v type-key)
+                  token-type (cto/dtcg-token-type->token-type token-type-str)]
+              (if (and (not (some? token-type)) (some? token-type-str))
+                (assoc unknown-tokens child-path token-type-str)
+                unknown-tokens)))))
+      nil
+      decoded-json))))
 
 ;; === Serialization handlers for RPC API (transit) and database (fressian)
 

common/src/app/common/types/variant.cljc

@@ -33,7 +33,8 @@
   ;; The root shape of the main instance of a variant component.
   [:map
    [:variant-id {:optional true} ::sm/uuid]
-   [:variant-name {:optional true} :string]])
+   [:variant-name {:optional true} :string]
+   [:variant-error {:optional true} :string]])
 
 (def schema:variant-container
   ;; is a board that contains all variant components of a variant set,
@@ -53,6 +54,7 @@
 
 (def property-prefix "Property")
 (def property-regex (re-pattern (str property-prefix "(\\d+)")))
+(def property-max-length 60)
 (def value-prefix "Value ")
 
 
@@ -106,8 +108,8 @@
      (add-new-props assigned remaining))))
 
 
-(defn properties-map-to-string
-  "Transforms a map of properties to a string of properties omitting the empty ones"
+(defn properties-map->formula
+  "Transforms a map of properties to a formula of properties omitting the empty ones"
   [properties]
   (->> properties
        (keep (fn [{:keys [name value]}]
@@ -116,21 +118,26 @@
        (str/join ", ")))
 
 
-(defn properties-string-to-map
-  "Transforms a string of properties to a map of properties"
+(defn properties-formula->map
+  "Transforms a formula of properties to a map of properties"
   [s]
   (->> (str/split s ",")
-       (mapv #(str/split % "="))
+       (mapv #(str/split % "=" 2))
+       (filter (fn [[_ v]] (not (str/blank? v))))
        (mapv (fn [[k v]]
                {:name (str/trim k)
                 :value (str/trim v)}))))
 
 
-(defn valid-properties-string?
-  "Checks if a string of properties has a processable format or not"
+(defn valid-properties-formula?
+  "Checks if a formula is valid"
   [s]
-  (let [pattern #"^([a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)(,\s*[a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)*$"]
-    (not (nil? (re-matches pattern s)))))
+  (->> (str/split s ",")
+       (mapv #(str/split % "=" 2))
+       (every? #(and (= 2 (count %))
+                     (not (str/blank? (first %)))
+                     (< (count (first %)) property-max-length)
+                     (< (count (second %)) property-max-length)))))
 
 
 (defn find-properties-to-remove

common/test/common_tests/files_builder_test.cljc

@@ -1,26 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns common-tests.files-builder-test
-  (:require
-   [app.common.files.builder :as builder]
-   [clojure.test :as t]))
-
-(t/deftest test-strip-image-extension
-  (t/testing "removes extension from supported image files"
-    (t/is (= (builder/strip-image-extension "foo.png") "foo"))
-    (t/is (= (builder/strip-image-extension "foo.webp") "foo"))
-    (t/is (= (builder/strip-image-extension "foo.jpg") "foo"))
-    (t/is (= (builder/strip-image-extension "foo.jpeg") "foo"))
-    (t/is (= (builder/strip-image-extension "foo.svg") "foo"))
-    (t/is (= (builder/strip-image-extension "foo.gif") "foo")))
-
-  (t/testing "does not remove extension for unsupported files"
-    (t/is (= (builder/strip-image-extension "foo.txt") "foo.txt"))
-    (t/is (= (builder/strip-image-extension "foo.bmp") "foo.bmp")))
-
-  (t/testing "leaves filename intact when it has no extension"
-    (t/is (= (builder/strip-image-extension "README") "README"))))

common/test/common_tests/files_migrations_test.cljc

@@ -21,6 +21,6 @@
       (let [file  {:data {:sum 1}
                    :id 1
                    :migrations (d/ordered-set "test/1")}
-            file' (cfm/migrate file)]
+            file' (cfm/migrate file nil)]
         (t/is (= cfm/available-migrations (:migrations file')))
         (t/is (= 3 (:sum (:data file'))))))))

common/test/common_tests/geom_shapes_test.cljc

@@ -114,11 +114,8 @@
     (let [modifiers    (ctm/resize-modifiers (gpt/point 0 0) (gpt/point 0 0))
           shape-before (create-test-shape :rect {:modifiers modifiers})
           shape-after  (gsh/transform-shape shape-before)]
-
-      (t/is (close? (get-in shape-before [:selrect :width])
-                    (get-in shape-after  [:selrect :width])))
-      (t/is (close? (get-in shape-before [:selrect :height])
-                    (get-in shape-after  [:selrect :height])))))
+      (t/is (close? 0.01 (get-in shape-after  [:selrect :width])))
+      (t/is (close? 0.01 (get-in shape-after  [:selrect :height])))))
 
   (t/testing "Transform shape with rotation modifiers"
     (t/are [type]

common/test/common_tests/logic/text_sync_test.cljc

@@ -0,0 +1,881 @@
+;; 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 common-tests.logic.text-sync-test
+  (:require
+   [app.common.files.changes-builder :as pcb]
+   [app.common.logic.libraries :as cll]
+   [app.common.logic.shapes :as cls]
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.compositions :as tho]
+   [app.common.test-helpers.files :as thf]
+   [app.common.test-helpers.ids-map :as thi]
+   [app.common.test-helpers.shapes :as ths]
+   [clojure.test :as t]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+
+(t/deftest test-sync-unchanged-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        main-child (ths/get-shape file :main-child)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :font-size] "32"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "32" (:font-size line)))
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-unchanged-copy-when-changed-text
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        main-child (ths/get-shape file :main-child)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    (t/is (= "Bye" (:text line)))))
+
+(t/deftest test-sync-unchanged-copy-when-changed-both
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        main-child (ths/get-shape file :main-child)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "32" (:font-size line)))
+    (t/is (= "Bye" (:text line)))))
+
+(t/deftest test-sync-updated-attr-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :font-weight] "700"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :font-size] "32"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because it was touched
+    (t/is (= "14" (:font-size line)))
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-attr-copy-when-changed-text
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :font-weight] "700"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    ;; The text is updated because only attrs were touched
+    (t/is (= "Bye" (:text line)))))
+
+(t/deftest test-sync-updated-attr-copy-when-changed-both
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :font-weight] "700"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because it was touched
+    (t/is (= "14" (:font-size line)))
+    ;; The text is updated because only attrs were touched
+    (t/is (= "Bye" (:text line)))))
+
+(t/deftest test-sync-updated-text-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Hi"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :font-size] "32"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr is updated because only text were touched
+    (t/is (= "32" (:font-size line)))
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-text-copy-when-changed-text
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Hi"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because it was touched
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-text-copy-when-changed-both
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Hi"))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr is updated because only text were touched
+    (t/is (= "32" (:font-size line)))
+    ;; The text doesn't change, because it was touched
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-both-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (-> shape
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :font-weight] "700")
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :text] "Hi")))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :font-size] "32"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because it was touched
+    (t/is (= "14" (:font-size line)))
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-both-copy-when-changed-text
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (-> shape
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :font-weight] "700")
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :text] "Hi")))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because it was touched
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-both-copy-when-changed-both
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (-> shape
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :font-weight] "700")
+                                                     (assoc-in [:content :children 0 :children 0 :children 0 :text] "Hi")))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because it was touched
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because it was touched
+    (t/is (= "Hi" (:text line)))))
+
+(t/deftest test-sync-updated-structure-same-attrs-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (get-in shape [:content :children 0 :children 0 :children 0])]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   ;; Update the attrs on all the content tree
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :font-size] "32")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr is updated because all the attrs on the structure are equal
+    (t/is (= "32" (:font-size line)))
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-structure-same-attrs-copy-when-changed-text
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (get-in shape [:content :children 0 :children 0 :children 0])]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because the structure was touched
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-structure-same-attrs-copy-when-changed-both
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (get-in shape [:content :children 0 :children 0 :children 0])]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                     ;; Update the attrs on all the content tree
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr is updated because all the attrs on the structure are equal
+    (t/is (= "32" (:font-size line)))
+    ;; The text doesn't change, because the structure was touched
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-structure-diff-attrs-copy-when-changed-attribute
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (-> (get-in shape [:content :children 0 :children 0 :children 0])
+                                                                (assoc :font-weight "700"))]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   ;; Update the attrs on all the content tree
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :font-size] "32")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because not all the attrs on the structure are equal
+    (t/is (= "14" (:font-size line)))
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-structure-diff-attrs-copy-when-changed-text
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (-> (get-in shape [:content :children 0 :children 0 :children 0])
+                                                                (assoc :font-weight "700"))]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                   (assoc-in shape [:content :children 0 :children 0 :children 0 :text] "Bye"))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because the structure was touched
+    (t/is (= "hello world" (:text line)))))
+
+(t/deftest test-sync-updated-structure-diff-attrs-copy-when-changed-both
+  (let [;; ==== Setup
+        file0      (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page0      (thf/current-page file0)
+        copy-child (ths/get-shape file0 :copy-child)
+
+        changes    (cls/generate-update-shapes (pcb/empty-changes nil (:id page0))
+                                               #{(:id copy-child)}
+                                               (fn [shape]
+                                                 (let [line (-> (get-in shape [:content :children 0 :children 0 :children 0])
+                                                                (assoc :font-weight "700"))]
+                                                   (update-in shape [:content :children 0 :children 0 :children]
+                                                              #(conj % line))))
+                                               (:objects (thf/current-page file0))
+                                               {})
+        file       (thf/apply-changes file0 changes)
+        main-child (ths/get-shape file :main-child)
+        page       (thf/current-page file)
+
+        ;; ==== Action
+        changes1     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                 #{(:id main-child)}
+                                                 (fn [shape]
+                                                     ;; Update the attrs on all the content tree
+                                                   (-> shape
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :font-size] "32")
+                                                       (assoc-in [:content :children 0 :children 0 :children 0 :text] "Bye")))
+                                                 (:objects page)
+                                                 {})
+
+        updated-file (thf/apply-changes file changes1)
+
+        changes2     (cll/generate-sync-file-changes (pcb/empty-changes)
+                                                     nil
+                                                     :components
+                                                     (:id updated-file)
+                                                     (thi/id :component1)
+                                                     (:id updated-file)
+                                                     {(:id updated-file) updated-file}
+                                                     (:id updated-file))
+
+        file'     (thf/apply-changes updated-file changes2)
+
+        ;; ==== Get
+        copy-child' (ths/get-shape file' :copy-child)
+        line (get-in copy-child' [:content :children 0 :children 0 :children 0])]
+    ;; The attr doesn't change, because not all the attrs on the structure are equal
+    (t/is (= "14" (:font-size line)))
+    ;; The text doesn't change, because the structure was touched
+    (t/is (= "hello world" (:text line)))))

common/test/common_tests/logic/text_touched_test.cljc

@@ -0,0 +1,132 @@
+;; 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 common-tests.logic.text-touched-test
+  (:require
+   [app.common.files.changes-builder :as pcb]
+   [app.common.logic.shapes :as cls]
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.compositions :as tho]
+   [app.common.test-helpers.files :as thf]
+   [app.common.test-helpers.ids-map :as thi]
+   [app.common.test-helpers.shapes :as ths]
+   [clojure.test :as t]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+(t/deftest test-text-copy-changed-attribute
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        copy-child (ths/get-shape file :copy-child)
+
+        ;; ==== Action
+        changes     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                #{(:id copy-child)}
+                                                (fn [shape]
+                                                  (assoc-in shape [:content :children 0 :children 0 :font-size] "32"))
+                                                (:objects page)
+                                                {})
+
+        file'       (thf/apply-changes file changes)
+        copy-child' (ths/get-shape file' :copy-child)]
+    (t/is (= #{:content-group :text-content-attribute} (:touched copy-child')))))
+
+(t/deftest test-text-copy-changed-text
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        copy-child (ths/get-shape file :copy-child)
+
+        ;; ==== Action
+        changes     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                #{(:id copy-child)}
+                                                (fn [shape]
+                                                  (assoc-in shape [:content :children 0 :children 0 :text] "Bye"))
+                                                (:objects page)
+                                                {})
+
+        file'       (thf/apply-changes file changes)
+        copy-child' (ths/get-shape file' :copy-child)]
+    (t/is (= #{:content-group :text-content-text} (:touched copy-child')))))
+
+(t/deftest test-text-copy-changed-both
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        copy-child (ths/get-shape file :copy-child)
+
+        ;; ==== Action
+        changes     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                #{(:id copy-child)}
+                                                (fn [shape]
+                                                  (-> shape
+                                                      (assoc-in [:content :children 0 :children 0 :font-size] "32")
+                                                      (assoc-in [:content :children 0 :children 0 :text] "Bye")))
+                                                (:objects page)
+                                                {})
+
+        file'       (thf/apply-changes file changes)
+        copy-child' (ths/get-shape file' :copy-child)]
+    (t/is (= #{:content-group :text-content-attribute :text-content-text} (:touched copy-child')))))
+
+(t/deftest test-text-copy-changed-structure-same-attrs
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        copy-child (ths/get-shape file :copy-child)
+
+        ;; ==== Action
+        changes     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                #{(:id copy-child)}
+                                                (fn [shape]
+                                                  (let [line (get-in shape [:content :children 0 :children 0])]
+                                                    (update-in shape [:content :children 0 :children]
+                                                               #(conj % line))))
+                                                (:objects page)
+                                                {})
+
+        file'       (thf/apply-changes file changes)
+        copy-child' (ths/get-shape file' :copy-child)]
+    (t/is (= #{:content-group :text-content-structure :text-content-structure-same-attrs} (:touched copy-child')))))
+
+(t/deftest test-text-copy-changed-structure-diff-attrs
+  (let [;; ==== Setup
+        file       (-> (thf/sample-file :file1)
+                       (tho/add-frame-with-text :main-root :main-child "hello world")
+                       (thc/make-component :component1 :main-root)
+                       (thc/instantiate-component :component1 :copy-root {:children-labels [:copy-child]}))
+        page       (thf/current-page file)
+        copy-child (ths/get-shape file :copy-child)
+
+        ;; ==== Action
+        changes     (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
+                                                #{(:id copy-child)}
+                                                (fn [shape]
+                                                  (let [line (-> shape
+                                                                 (get-in [:content :children 0 :children 0])
+                                                                 (assoc :font-size "32"))]
+                                                    (update-in shape [:content :children 0 :children]
+                                                               #(conj % line))))
+                                                (:objects page)
+                                                {})
+
+        file'       (thf/apply-changes file changes)
+        copy-child' (ths/get-shape file' :copy-child)]
+    (t/is (= #{:content-group :text-content-structure} (:touched copy-child')))))
+

common/test/common_tests/media_test.cljc

@@ -0,0 +1,26 @@
+;; 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 common-tests.media-test
+  (:require
+   [app.common.media :as media]
+   [clojure.test :as t]))
+
+(t/deftest test-strip-image-extension
+  (t/testing "removes extension from supported image files"
+    (t/is (= (media/strip-image-extension "foo.png") "foo"))
+    (t/is (= (media/strip-image-extension "foo.webp") "foo"))
+    (t/is (= (media/strip-image-extension "foo.jpg") "foo"))
+    (t/is (= (media/strip-image-extension "foo.jpeg") "foo"))
+    (t/is (= (media/strip-image-extension "foo.svg") "foo"))
+    (t/is (= (media/strip-image-extension "foo.gif") "foo")))
+
+  (t/testing "does not remove extension for unsupported files"
+    (t/is (= (media/strip-image-extension "foo.txt") "foo.txt"))
+    (t/is (= (media/strip-image-extension "foo.bmp") "foo.bmp")))
+
+  (t/testing "leaves filename intact when it has no extension"
+    (t/is (= (media/strip-image-extension "README") "README"))))

common/test/common_tests/runner.cljc

@@ -9,7 +9,6 @@
    [clojure.test :as t]
    [common-tests.colors-test]
    [common-tests.data-test]
-   [common-tests.files-builder-test]
    [common-tests.files-changes-test]
    [common-tests.files-migrations-test]
    [common-tests.geom-point-test]
@@ -29,6 +28,7 @@
    [common-tests.logic.swap-and-reset-test]
    [common-tests.logic.swap-as-override-test]
    [common-tests.logic.token-test]
+   [common-tests.media-test]
    [common-tests.pages-helpers-test]
    [common-tests.record-test]
    [common-tests.schema-test]
@@ -58,7 +58,6 @@
   (t/run-tests
    'common-tests.colors-test
    'common-tests.data-test
-   'common-tests.files-builder-test
    'common-tests.files-changes-test
    'common-tests.files-migrations-test
    'common-tests.geom-point-test
@@ -78,6 +77,7 @@
    'common-tests.logic.swap-and-reset-test
    'common-tests.logic.swap-as-override-test
    'common-tests.logic.token-test
+   'common-tests.media-test
    'common-tests.pages-helpers-test
    'common-tests.record-test
    'common-tests.schema-test
@@ -85,11 +85,11 @@
    'common-tests.svg-test
    'common-tests.text-test
    'common-tests.time-test
-   'common-tests.types.modifiers-test
-   'common-tests.types.shape-interactions-test
-   'common-tests.types.shape-decode-encode-test
-   'common-tests.types.tokens-lib-test
-   'common-tests.types.components-test
    'common-tests.types.absorb-assets-test
+   'common-tests.types.components-test
+   'common-tests.types.modifiers-test
    'common-tests.types.path-data-test
+   'common-tests.types.shape-decode-encode-test
+   'common-tests.types.shape-interactions-test
+   'common-tests.types.tokens-lib-test
    'common-tests.uuid-test))

common/test/common_tests/types/data/tokens-single-set-dtcg-example.json

@@ -0,0 +1,11 @@
+{
+    "color": {
+        "red": {
+            "100": {
+                "$value": "red",
+                "$type": "color",
+                "$description": ""
+            }
+        }
+    }
+}

common/test/common_tests/types/data/tokens-single-set-legacy-example.json

@@ -0,0 +1,11 @@
+{
+    "color": {
+        "red": {
+            "100": {
+                "value": "red",
+                "type": "color",
+                "description": ""
+            }
+        }
+    }
+}

common/test/common_tests/types/text_test.cljc

@@ -0,0 +1,88 @@
+;; 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 common-tests.types.text-test
+  (:require
+
+   [app.common.text :as txt]
+   [app.common.types.shape :as cts]
+   [app.common.types.text :as cttx]
+   [clojure.test :as t :include-macros true]))
+
+(def content-base (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
+                      (txt/change-text "hello world")
+                      (assoc :position-data nil)
+                      :content))
+
+(def content-changed-text (assoc-in content-base [:children 0 :children 0 :children 0 :text] "changed"))
+(def content-changed-attr (assoc-in content-base [:children 0 :children 0 :children 0 :font-size] "32"))
+(def content-changed-both (-> content-base
+                              (assoc-in [:children 0 :children 0 :children 0 :text] "changed")
+                              (assoc-in  [:children 0 :children 0 :children 0 :font-size] "32")))
+(def line (get-in content-base [:children 0 :children 0 :children 0]))
+(def content-changed-structure (update-in content-base [:children 0 :children 0 :children]
+                                          #(conj % (assoc line :font-weight "700"))))
+(def content-changed-structure-same-attrs (update-in content-base [:children 0 :children 0 :children]
+                                                     #(conj % line)))
+
+(t/deftest test-get-diff-type
+  (let [diff-text (cttx/get-diff-type content-base content-changed-text)
+        diff-attr (cttx/get-diff-type content-base content-changed-attr)
+        diff-both (cttx/get-diff-type content-base content-changed-both)
+        diff-structure (cttx/get-diff-type content-base content-changed-structure)
+        diff-structure-same-attrs (cttx/get-diff-type content-base content-changed-structure-same-attrs)]
+    (t/is (= #{:text-content-text} diff-text))
+    (t/is (= #{:text-content-attribute} diff-attr))
+    (t/is (= #{:text-content-text :text-content-attribute} diff-both))
+    (t/is (= #{:text-content-structure} diff-structure))
+    (t/is (= #{:text-content-structure :text-content-structure-same-attrs} diff-structure-same-attrs))))
+
+
+(t/deftest test-equal-structure
+  (t/is (true? (cttx/equal-structure? content-base content-changed-text)))
+  (t/is (true? (cttx/equal-structure? content-base content-changed-attr)))
+  (t/is (true? (cttx/equal-structure? content-base content-changed-both)))
+  (t/is (false? (cttx/equal-structure? content-base content-changed-structure))))
+
+
+(t/deftest test-copy-text-keys
+  (let [copy-base-to-changed-text (cttx/copy-text-keys content-base content-changed-text)
+        copy-changed-text-to-base (cttx/copy-text-keys content-changed-text content-base)
+
+        copy-base-to-changed-attr (cttx/copy-text-keys content-base content-changed-attr)
+
+        copy-changes-text-to-changed-attr (cttx/copy-text-keys content-changed-text content-changed-attr)
+        updates-text-in-changed-attr (assoc-in content-changed-attr [:children 0 :children 0 :children 0 :text] "changed")]
+
+    ;; If we copy the text of the base to the content-changed-text, the result is equal than the base
+    (t/is (= copy-base-to-changed-text content-base))
+
+    ;; If we copy the text of the content-changed-text to the base, the result is equal than the content-changed-text
+    (t/is (= copy-changed-text-to-base content-changed-text))
+
+    ;; If we copy the text of the base to the content-changed-attr, it doesn't nothing because the text were equal
+    (t/is (= copy-base-to-changed-attr content-changed-attr))
+
+    ;; If we copy the text of the content-changed-text to the content-changed-attr, it keeps the changes on the attrs
+    ;; and the changes on the texts
+    (t/is (= copy-changes-text-to-changed-attr updates-text-in-changed-attr))))
+
+
+(t/deftest test-copy-attrs-keys
+  (let [attrs (-> (cttx/get-first-paragraph-text-attrs content-changed-structure-same-attrs)
+                  (assoc :font-size "32"))
+        updated (cttx/copy-attrs-keys content-changed-structure-same-attrs attrs)
+        get-font-sizes (fn get-font-sizes [fonts item]
+                         (let [font-size (:font-size item)
+                               fonts (if font-size (conj fonts font-size) fonts)]
+                           (if (seq (:children item))
+                             (reduce get-font-sizes fonts (:children item))
+                             fonts)))
+        original-font-sizes (get-font-sizes [] content-changed-structure-same-attrs)
+        updated-font-sizes (get-font-sizes [] updated)]
+
+    (t/is (every? #(= % "14") original-font-sizes))
+    (t/is (every? #(= % "32") updated-font-sizes))))

common/test/common_tests/types/tokens_lib_test.cljc

@@ -7,8 +7,9 @@
 (ns common-tests.types.tokens-lib-test
   (:require
    #?(:clj [app.common.fressian :as fres])
+   #?(:clj [app.common.json :as json])
+   #?(:clj [app.common.test-helpers.tokens :as tht])
    [app.common.data :as d]
-   [app.common.test-helpers.tokens :as tht]
    [app.common.time :as dt]
    [app.common.transit :as tr]
    [app.common.types.tokens-lib :as ctob]
@@ -1387,47 +1388,28 @@
     (t/is (nil? token-theme'))))
 
 #?(:clj
-   (t/deftest legacy-json-decoding
-     (let [json (-> (slurp "test/common_tests/types/data/tokens-multi-set-legacy-example.json")
-                    (tr/decode-str))
-           lib (ctob/decode-legacy-json (ctob/ensure-tokens-lib nil) json)
-           get-set-token (fn [set-name token-name]
-                           (some-> (ctob/get-set lib set-name)
-                                   (ctob/get-token token-name)
-                                   (dissoc :modified-at)))
-           token-theme (ctob/get-theme lib "group-1" "theme-1")]
-       (t/is (= '("core" "light" "dark" "theme") (ctob/get-ordered-set-names lib)))
-       (t/testing "set exists in theme"
-         (t/is (= (:group token-theme) "group-1"))
-         (t/is (= (:name token-theme) "theme-1"))
-         (t/is (= (:sets token-theme) #{"light"})))
-       (t/testing "tokens exist in core set"
-         (t/is (= (get-set-token "core" "colors.red.600")
-                  {:name "colors.red.600"
-                   :type :color
-                   :value "#e53e3e"
-                   :description ""}))
-         (t/is (= (get-set-token "core" "spacing.multi-value")
-                  {:name "spacing.multi-value"
-                   :type :spacing
-                   :value "{dimension.sm} {dimension.xl}"
-                   :description "You can have multiple values in a single spacing token"}))
-         (t/is (= (get-set-token "theme" "button.primary.background")
-                  {:name "button.primary.background"
-                   :type :color
-                   :value "{accent.default}"
-                   :description ""})))
-       (t/testing "invalid tokens got discarded"
-         (t/is (nil? (get-set-token "typography" "H1.Bold")))))))
+   (t/deftest parse-single-set-legacy-json
+     (let [json (-> (slurp "test/common_tests/types/data/tokens-single-set-legacy-example.json")
+                    (json/decode {:key-fn identity}))
+           lib (ctob/parse-decoded-json json "single_set")]
+       (t/is (= '("single_set") (ctob/get-ordered-set-names lib)))
+       (t/testing "token added"
+         (t/is (some? (ctob/get-token-in-set lib "single_set" "color.red.100")))))))
 
 #?(:clj
-   (t/deftest dtcg-encoding-decoding-json
-     (let [json (-> (slurp "test/common_tests/types/data/tokens-multi-set-example.json")
-                    (tr/decode-str))
-           lib (ctob/decode-dtcg-json (ctob/ensure-tokens-lib nil) json)
-           get-set-token (fn [set-name token-name]
-                           (some-> (ctob/get-set lib set-name)
-                                   (ctob/get-token token-name)))
+   (t/deftest parse-single-set-dtcg-json
+     (let [json (-> (slurp "test/common_tests/types/data/tokens-single-set-dtcg-example.json")
+                    (json/decode {:key-fn identity}))
+           lib (ctob/parse-decoded-json json "single_set")]
+       (t/is (= '("single_set") (ctob/get-ordered-set-names lib)))
+       (t/testing "token added"
+         (t/is (some? (ctob/get-token-in-set lib "single_set" "color.red.100")))))))
+
+#?(:clj
+   (t/deftest parse-multi-set-legacy-json
+     (let [json (-> (slurp "test/common_tests/types/data/tokens-multi-set-legacy-example.json")
+                    (json/decode {:key-fn identity}))
+           lib (ctob/parse-decoded-json json "")
            token-theme (ctob/get-theme lib "group-1" "theme-1")]
        (t/is (= '("core" "light" "dark" "theme") (ctob/get-ordered-set-names lib)))
        (t/testing "set exists in theme"
@@ -1435,32 +1417,59 @@
          (t/is (= (:name token-theme) "theme-1"))
          (t/is (= (:sets token-theme) #{"light"})))
        (t/testing "tokens exist in core set"
-         (t/is (tht/token-data-eq? (get-set-token "core" "colors.red.600")
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "core" "colors.red.600")
                                    {:name "colors.red.600"
                                     :type :color
                                     :value "#e53e3e"
                                     :description ""}))
-         (t/is (tht/token-data-eq? (get-set-token "core" "spacing.multi-value")
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "core" "spacing.multi-value")
                                    {:name "spacing.multi-value"
                                     :type :spacing
                                     :value "{dimension.sm} {dimension.xl}"
                                     :description "You can have multiple values in a single spacing token"}))
-         (t/is (tht/token-data-eq? (get-set-token "theme" "button.primary.background")
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "theme" "button.primary.background")
                                    {:name "button.primary.background"
                                     :type :color
                                     :value "{accent.default}"
                                     :description ""})))
        (t/testing "invalid tokens got discarded"
-         (t/is (nil? (get-set-token "typography" "H1.Bold")))))))
+         (t/is (nil? (ctob/get-token-in-set lib "typography" "H1.Bold")))))))
 
 #?(:clj
-   (t/deftest decode-dtcg-json-default-team
+   (t/deftest parse-multi-set-dtcg-json
+     (let [json (-> (slurp "test/common_tests/types/data/tokens-multi-set-example.json")
+                    (json/decode {:key-fn identity}))
+           lib (ctob/parse-decoded-json json "")
+           token-theme (ctob/get-theme lib "group-1" "theme-1")]
+       (t/is (= '("core" "light" "dark" "theme") (ctob/get-ordered-set-names lib)))
+       (t/testing "set exists in theme"
+         (t/is (= (:group token-theme) "group-1"))
+         (t/is (= (:name token-theme) "theme-1"))
+         (t/is (= (:sets token-theme) #{"light"})))
+       (t/testing "tokens exist in core set"
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "core" "colors.red.600")
+                                   {:name "colors.red.600"
+                                    :type :color
+                                    :value "#e53e3e"
+                                    :description ""}))
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "core" "spacing.multi-value")
+                                   {:name "spacing.multi-value"
+                                    :type :spacing
+                                    :value "{dimension.sm} {dimension.xl}"
+                                    :description "You can have multiple values in a single spacing token"}))
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "theme" "button.primary.background")
+                                   {:name "button.primary.background"
+                                    :type :color
+                                    :value "{accent.default}"
+                                    :description ""})))
+       (t/testing "invalid tokens got discarded"
+         (t/is (nil? (ctob/get-token-in-set lib "typography" "H1.Bold")))))))
+
+#?(:clj
+   (t/deftest parse-multi-set-dtcg-json-default-team
      (let [json (-> (slurp "test/common_tests/types/data/tokens-default-team-only.json")
-                    (tr/decode-str))
-           lib (ctob/decode-dtcg-json (ctob/ensure-tokens-lib nil) json)
-           get-set-token (fn [set-name token-name]
-                           (some-> (ctob/get-set lib set-name)
-                                   (ctob/get-token token-name)))
+                    (json/decode {:key-fn identity}))
+           lib (ctob/parse-decoded-json json "")
            themes (ctob/get-themes lib)
            first-theme (first themes)]
        (t/is (= '("dark") (ctob/get-ordered-set-names lib)))
@@ -1469,15 +1478,14 @@
          (t/is (= (:group first-theme) ""))
          (t/is (= (:name first-theme) ctob/hidden-token-theme-name)))
        (t/testing "token exist in dark set"
-         (t/is (tht/token-data-eq? (get-set-token "dark" "small")
+         (t/is (tht/token-data-eq? (ctob/get-token-in-set lib "dark" "small")
                                    {:name "small"
                                     :value "8"
                                     :type :border-radius
                                     :description ""}))))))
 
-
 #?(:clj
-   (t/deftest encode-dtcg-json
+   (t/deftest export-dtcg-json
      (let [now (dt/now)
            tokens-lib (-> (ctob/make-tokens-lib)
                           (ctob/add-set (ctob/make-token-set :name "core"
@@ -1502,7 +1510,7 @@
                                                                  :id "test-id-00"
                                                                  :modified-at now
                                                                  :sets #{"core"})))
-           result   (ctob/encode-dtcg tokens-lib)
+           result   (ctob/export-dtcg-json tokens-lib)
            expected {"$themes" [{"description" ""
                                  "group" "group-1"
                                  "is-source" false
@@ -1528,7 +1536,7 @@
        (t/is (= expected result)))))
 
 #?(:clj
-   (t/deftest encode-decode-dtcg-json
+   (t/deftest export-parse-dtcg-json
      (with-redefs [dt/now (constantly #inst "2024-10-16T12:01:20.257840055-00:00")]
        (let [tokens-lib (-> (ctob/make-tokens-lib)
                             (ctob/add-set (ctob/make-token-set :name "core"
@@ -1549,17 +1557,14 @@
                                                                           :type :color
                                                                           :value "{accent.default}"})})))
 
-             encoded (ctob/encode-dtcg tokens-lib)
-             with-prev-tokens-lib (ctob/decode-dtcg-json tokens-lib encoded)
-             with-empty-tokens-lib (ctob/decode-dtcg-json (ctob/ensure-tokens-lib nil) encoded)]
+             encoded (ctob/export-dtcg-json tokens-lib)
+             tokens-lib' (ctob/parse-decoded-json encoded "")]
          (t/testing "library got updated but data is equal"
-           (t/is (not= with-prev-tokens-lib tokens-lib))
-           (t/is (= @with-prev-tokens-lib @tokens-lib)))
-         (t/testing "fresh tokens library is also equal"
-           (= @with-empty-tokens-lib @tokens-lib))))))
+           (t/is (not= tokens-lib' tokens-lib))
+           (t/is (= @tokens-lib' @tokens-lib)))))))
 
 #?(:clj
-   (t/deftest encode-default-theme-json
+   (t/deftest export-dtcg-json-with-default-theme
      (let [tokens-lib (-> (ctob/make-tokens-lib)
                           (ctob/add-set (ctob/make-token-set :name "core"
                                                              :tokens {"colors.red.600"
@@ -1578,7 +1583,7 @@
                                                                        {:name "button.primary.background"
                                                                         :type :color
                                                                         :value "{accent.default}"})})))
-           result   (ctob/encode-dtcg tokens-lib)
+           result   (ctob/export-dtcg-json tokens-lib)
            expected {"$themes" []
                      "$metadata" {"tokenSetOrder" ["core"]
                                   "activeSets" #{},  "activeThemes" #{}}
@@ -1599,7 +1604,7 @@
        (t/is (= expected result)))))
 
 #?(:clj
-   (t/deftest encode-dtcg-json-with-active-theme-and-set
+   (t/deftest export-dtcg-json-with-active-theme-and-set
      (let [now (dt/now)
            tokens-lib (-> (ctob/make-tokens-lib)
                           (ctob/add-set (ctob/make-token-set :name "core"
@@ -1625,7 +1630,7 @@
                                                                  :modified-at now
                                                                  :sets #{"core"}))
                           (ctob/toggle-theme-active? "group-1" "theme-1"))
-           result   (ctob/encode-dtcg tokens-lib)
+           result   (ctob/export-dtcg-json tokens-lib)
            expected {"$themes" [{"description" ""
                                  "group" "group-1"
                                  "is-source" false

common/test/common_tests/variant_test.cljc

@@ -9,32 +9,57 @@
    [app.common.types.variant :as ctv]
    [clojure.test :as t]))
 
-(t/deftest convert-between-variant-properties-maps-and-strings
+(t/deftest convert-between-variant-properties-maps-and-formulas
   (let [map-with-two-props           [{:name "border" :value "yes"} {:name "color" :value "gray"}]
         map-with-two-props-one-blank [{:name "border" :value "no"} {:name "color" :value ""}]
+        map-with-two-props-dashes    [{:name "border" :value "no"} {:name "color" :value "--"}]
         map-with-one-prop            [{:name "border" :value "no"}]
-        map-with-spaces              [{:name "border 1" :value "of course"} {:name "color 2" :value "dark gray"}]
+        map-with-equal               [{:name "border" :value "yes color=yes"}]
+        map-with-spaces              [{:name "border 1" :value "of course"}
+                                      {:name "color 2" :value "dark gray"}
+                                      {:name "background 3" :value "anoth€r co-lor"}]
 
         string-valid-with-two-props  "border=yes, color=gray"
         string-valid-with-one-prop   "border=no"
-        string-valid-with-spaces     "border 1=of course, color 2=dark gray"
-        string-invalid               "border=yes, color="]
+        string-valid-with-spaces     "border 1=of course, color 2=dark gray, background 3=anoth€r co-lor"
+        string-valid-with-no-value   "border=no, color="
+        string-valid-with-dashes     "border=no, color=--"
+        string-valid-with-equal      "border=yes color=yes"
 
-    (t/testing "convert map to string"
-      (t/is (= (ctv/properties-map-to-string map-with-two-props) string-valid-with-two-props))
-      (t/is (= (ctv/properties-map-to-string map-with-two-props-one-blank) string-valid-with-one-prop))
-      (t/is (= (ctv/properties-map-to-string map-with-spaces) string-valid-with-spaces)))
+        string-invalid-empty         ""
+        string-invalid-no-property-1 "=yes"
+        string-invalid-no-property-2 "border=yes, =gray"
+        string-invalid-no-equal-1    "border"
+        string-invalid-no-equal-2    "border=yes, color"
+        string-invalid-too-long-1    "this is a too long property name which should throw a validation error=yes"
+        string-invalid-too-long-2    "border=this is a too long property name which should throw a validation error"]
 
-    (t/testing "convert string to map"
-      (t/is (= (ctv/properties-string-to-map string-valid-with-two-props) map-with-two-props))
-      (t/is (= (ctv/properties-string-to-map string-valid-with-one-prop) map-with-one-prop))
-      (t/is (= (ctv/properties-string-to-map string-valid-with-spaces) map-with-spaces)))
+    (t/testing "convert map to formula"
+      (t/is (= (ctv/properties-map->formula map-with-two-props) string-valid-with-two-props))
+      (t/is (= (ctv/properties-map->formula map-with-two-props-one-blank) string-valid-with-one-prop))
+      (t/is (= (ctv/properties-map->formula map-with-spaces) string-valid-with-spaces)))
 
-    (t/testing "check if a string is valid"
-      (t/is (= (ctv/valid-properties-string? string-valid-with-two-props) true))
-      (t/is (= (ctv/valid-properties-string? string-valid-with-one-prop) true))
-      (t/is (= (ctv/valid-properties-string? string-valid-with-spaces) true))
-      (t/is (= (ctv/valid-properties-string? string-invalid) false)))))
+    (t/testing "convert formula to map"
+      (t/is (= (ctv/properties-formula->map string-valid-with-two-props) map-with-two-props))
+      (t/is (= (ctv/properties-formula->map string-valid-with-one-prop) map-with-one-prop))
+      (t/is (= (ctv/properties-formula->map string-valid-with-no-value) map-with-one-prop))
+      (t/is (= (ctv/properties-formula->map string-valid-with-dashes) map-with-two-props-dashes))
+      (t/is (= (ctv/properties-formula->map string-valid-with-equal) map-with-equal))
+      (t/is (= (ctv/properties-formula->map string-valid-with-spaces) map-with-spaces)))
+
+    (t/testing "check if a formula is valid"
+      (t/is (= (ctv/valid-properties-formula? string-valid-with-two-props) true))
+      (t/is (= (ctv/valid-properties-formula? string-valid-with-one-prop) true))
+      (t/is (= (ctv/valid-properties-formula? string-valid-with-spaces) true))
+      (t/is (= (ctv/valid-properties-formula? string-valid-with-no-value) true))
+      (t/is (= (ctv/valid-properties-formula? string-valid-with-dashes) true))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-empty) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-no-property-1) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-no-equal-1) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-no-property-2) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-no-equal-2) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-too-long-1) false))
+      (t/is (= (ctv/valid-properties-formula? string-invalid-too-long-2) false)))))
 
 
 (t/deftest find-properties

common/vendor/beicon/impl/rxjs.cljs

@@ -1,4 +0,0 @@
-(ns beicon.impl.rxjs
-  (:require ["rxjs" :as rx]))
-
-(goog/exportSymbol "rxjsMain" rx)

common/vendor/beicon/impl/rxjs_operators.cljs

@@ -1,4 +0,0 @@
-(ns beicon.impl.rxjs-operators
-  (:require ["rxjs/operators" :as rxop]))
-
-(goog/exportSymbol "rxjsOperators" rxop)

common/vendor/tubax/saxjs.cljs

@@ -1,4 +0,0 @@
-(ns tubax.saxjs
-  (:require ["sax" :as sax]))
-
-(goog/exportSymbol "sax" sax)

docker/devenv/Dockerfile

@@ -19,11 +19,7 @@ RUN set -ex; \
     echo "nameserver 8.8.8.8" > /etc/resolvconf/resolv.conf.d/tail; \
     apt-get -qq update; \
     apt-get -qqy install --no-install-recommends \
-        build-essential \
-        openssh-client \
-        redis-tools \
         locales \
-        gnupg2 \
         ca-certificates \
         wget \
         sudo \
@@ -32,19 +28,13 @@ RUN set -ex; \
         curl \
         bash \
         git \
-        rlwrap \
-        unzip \
-        rsync \
-        fakeroot \
-        file \
-        less \
-        jq \
-        nginx \
     ; \
     echo "en_US.UTF-8 UTF-8" >> /etc/locale.gen; \
     locale-gen; \
     rm -rf /var/lib/apt/lists/*;
 
+COPY files/apt.sources /etc/apt/sources.list.d/ubuntu.sources
+
 RUN set -ex; \
     usermod -l penpot -d /home/penpot -G users -s /bin/bash ubuntu; \
     passwd penpot -d; \
@@ -53,6 +43,19 @@ RUN set -ex; \
 RUN set -ex; \
     apt-get -qq update; \
     apt-get -qqy install --no-install-recommends \
+        build-essential \
+        openssh-client \
+        redis-tools \
+        gnupg2 \
+        rlwrap \
+        unzip \
+        rsync \
+        fakeroot \
+        file \
+        less \
+        jq \
+        nginx \
+        \
         python3 \
         python3-tabulate \
         imagemagick \
@@ -97,6 +100,23 @@ RUN set -ex; \
         libgbm1 \
         xvfb \
         libfontconfig-dev \
+        \
+        fonts-noto-color-emoji \
+        fonts-unifont \
+        libfreetype6 \
+        xfonts-cyrillic \
+        xfonts-scalable \
+        fonts-ipafont-gothic \
+        fonts-wqy-zenhei \
+        fonts-tlwg-loma-otf \
+        fonts-freefont-ttf \
+        libasound2t64 \
+        libatk-bridge2.0-0t64 \
+        libatk1.0-0t64 \
+        libatspi2.0-0t64 \
+        libcups2t64 \
+        libdrm2 \
+        libxkbcommon0 \
     ; \
     rm -rf /var/lib/apt/lists/*;
 
@@ -159,7 +179,6 @@ RUN set -eux; \
     tar -xf /tmp/nodejs.tar.gz --strip-components=1; \
     chown -R root /usr/local/nodejs; \
     corepack enable; \
-    npx playwright install --with-deps chromium; \
     rm -rf /tmp/nodejs.tar.gz;
 
 RUN set -ex; \
@@ -241,10 +260,10 @@ RUN set -ex; \
     mv /tmp/mc /usr/local/bin/; \
     chmod +x /usr/local/bin/mc;
 
+WORKDIR /usr/local
+
 # Install Rust toolchain
-ENV RUSTUP_HOME=/usr/local/rustup \
-    CARGO_HOME=/usr/local/cargo \
-    PATH=/usr/local/cargo/bin:$PATH;
+ENV PATH=/usr/local/cargo/bin:$PATH RUSTUP_HOME=/usr/local/rustpo CARGO_HOME=/usr/local/cargo
 
 RUN set -eux; \
     # Same steps as in Rust official Docker image https://github.com/rust-lang/docker-rust/blob/9f287282d513a84cb7c7f38f197838f15d37b6a9/1.81.0/bookworm/Dockerfile
@@ -254,27 +273,20 @@ RUN set -eux; \
         arm64) rustArch='aarch64-unknown-linux-gnu'; rustupSha256='1cffbf51e63e634c746f741de50649bbbcbd9dbe1de363c9ecef64e278dba2b2' ;; \
     *) echo >&2 "unsupported architecture: ${dpkgArch}"; exit 1 ;; \
     esac; \
-    url="https://static.rust-lang.org/rustup/archive/${RUSTUP_VERSION}/${rustArch}/rustup-init"; \
-    wget "$url"; \
+    wget "https://static.rust-lang.org/rustup/archive/${RUSTUP_VERSION}/${rustArch}/rustup-init"; \
     echo "${rustupSha256} *rustup-init" | sha256sum -c -; \
     chmod +x rustup-init; \
     ./rustup-init -y --no-modify-path --profile minimal --default-toolchain $RUST_VERSION --default-host ${rustArch}; \
     rm rustup-init; \
-    chmod -R a+w $RUSTUP_HOME $CARGO_HOME; \
     rustup component add rustfmt; \
-    rustup component add clippy;
-
-WORKDIR /usr/local
-
-# Install emscripten SDK and activate it
-RUN set -eux; \
-  git clone https://github.com/emscripten-core/emsdk.git; \
-  cd emsdk; \
-  ./emsdk install $EMSCRIPTEN_VERSION; \
-  ./emsdk activate $EMSCRIPTEN_VERSION; \
-  rustup target add wasm32-unknown-emscripten;
-
-WORKDIR /home
+    rustup component add clippy; \
+    git clone https://github.com/emscripten-core/emsdk.git; \
+    cd emsdk; \
+    ./emsdk install $EMSCRIPTEN_VERSION; \
+    ./emsdk activate $EMSCRIPTEN_VERSION; \
+    rustup target add wasm32-unknown-emscripten; \
+    cargo install cargo-watch; \
+    chown -R penpot:users $CARGO_HOME;
 
 COPY files/nginx.conf /etc/nginx/nginx.conf
 COPY files/nginx-mime.types /etc/nginx/mime.types

docker/devenv/files/apt.sources

@@ -0,0 +1,20 @@
+Types: deb
+URIs: http://mirror.kumi.systems/ubuntu/
+Suites: noble noble-updates noble-backports
+Components: main universe restricted multiverse
+Signed-By: /usr/share/keyrings/ubuntu-archive-keyring.gpg
+Architectures: amd64
+
+Types: deb
+URIs: http://mirror.kumi.systems/ubuntu-ports/
+Suites: noble noble-updates noble-backports
+Components: main universe restricted multiverse
+Signed-By: /usr/share/keyrings/ubuntu-archive-keyring.gpg
+Architectures: arm64
+
+Types: deb
+URIs: http://security.ubuntu.com/ubuntu/
+Suites: noble-security
+Components: main universe restricted multiverse
+Signed-By: /usr/share/keyrings/ubuntu-archive-keyring.gpg
+Architectures: amd64

docker/devenv/files/bashrc

@@ -1,10 +1,5 @@
 #!/usr/bin/env bash
 
-export JAVA_OPTS=${JAVA_OPTS:-"-Xmx1000m -Xms200m"};
-export PATH=/usr/lib/jvm/openjdk/bin:/usr/local/nodejs/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/snap/bin
-EMSDK_QUIET=1 . /usr/local/emsdk/emsdk_env.sh;
-source /usr/local/cargo/env
-
 alias l='ls --color -GFlh'
 alias rm='rm -r'
 alias ls='ls --color -F'

docker/devenv/files/entrypoint.sh

@@ -1,6 +1,19 @@
 #!/usr/bin/env bash
 
 set -e
-usermod -u ${EXTERNAL_UID:-1000} penpot
+
+EMSDK_QUIET=1 . /usr/local/emsdk/emsdk_env.sh;
+
+usermod -u ${EXTERNAL_UID:-1000} penpot;
+
+cp /root/.bashrc /home/penpot/.bashrc
+cp /root/.vimrc /home/penpot/.vimrc
+cp /root/.tmux.conf /home/penpot/.tmux.conf
+
+chown -R penpot:users /home/penpot
+rsync -ar --chown=penpot:users /usr/local/cargo/ /home/penpot/.cargo/
+
+export PATH="/home/penpot/.cargo/bin:$PATH"
+export CARGO_HOME="/home/penpot/.cargo"
 
 exec "$@"

docker/devenv/files/init.sh

@@ -1,10 +1,5 @@
 #!/usr/bin/env bash
 
-cp /root/.bashrc /home/penpot/.bashrc
-cp /root/.vimrc /home/penpot/.vimrc
-cp /root/.tmux.conf /home/penpot/.tmux.conf
-chown -R penpot:users /home/penpot
-
 set -e
 nginx
 tail -f /dev/null

docker/devenv/files/nginx.conf

@@ -138,6 +138,10 @@ http {
             proxy_pass http://127.0.0.1:6070/inbox;
         }
 
+        location /payments {
+            proxy_pass http://127.0.0.1:5000;
+        }
+
         location /playground {
             alias /home/penpot/penpot/experiments/;
             add_header Cache-Control "no-cache, max-age=0";