Compare commits

..

17 Commits

Author SHA1 Message Date
Francis Santiago
6703402207 Revert "add new configurations" 2025-05-12 16:47:43 +02:00
Francis Santiago
f93059412a Merge pull request #6463 from sancfc/develop
add new configurations
2025-05-12 16:04:01 +02:00
Francis Santiago
a65aa5ea44 Merge pull request #1 from sancfc/github-actions-bundle-build
GitHub actions bundle build
2025-05-07 10:57:56 +02:00
fsantiago
689063cfb2 add initial functionality 2025-05-07 10:05:54 +02:00
fsantiago
e146ce7be4 🧪 temporary debug test 2025-05-07 10:05:17 +02:00
fsantiago
0fbd9812b3 🧪 basic execution test 2025-05-07 10:05:07 +02:00
fsantiago
ccd7b3bdce 🔧 🧹 minor code cleanup 2025-05-07 10:04:58 +02:00
fsantiago
60f8cfd492 add more tests for zip flow 2025-05-07 10:04:41 +02:00
fsantiago
7359b800ce 🔧 🧹 reorganize zip type logic 2025-05-07 10:04:29 +02:00
fsantiago
0032639831 🐛 🐛 correct zip type validation 2025-05-07 10:04:13 +02:00
fsantiago
d9cdd020e6 ♻️ ♻️ improve zip type definition 2025-05-07 10:04:01 +02:00
fsantiago
10d021b15e implement zip type logic 2025-05-07 10:03:48 +02:00
fsantiago
3be750410e 🔧 🔧 update file paths in project 2025-05-07 10:03:36 +02:00
fsantiago
47552830b1 🧪 add temporary integration test 2025-05-07 10:03:24 +02:00
fsantiago
0fb41f54b0 add initial tests for zip feature 2025-05-07 10:02:56 +02:00
fsantiago
5b777921a6 📝 📝 update reference to PENPOT 2025-05-07 10:02:43 +02:00
fsantiago
42dcc81767 🔧 🔧 add initial pipeline configuration 2025-05-07 10:01:56 +02:00
520 changed files with 72173 additions and 88118 deletions

View File

@@ -1,53 +1,5 @@
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
@@ -65,7 +17,15 @@ jobs:
# Download and cache dependencies
- restore_cache:
keys:
- v1-dependencies-{{ checksum "common/deps.edn"}}-{{ checksum "common/yarn.lock" }}
- 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
- run:
name: "JVM tests"
@@ -77,16 +37,12 @@ jobs:
name: "NODE tests"
working_directory: "./common"
command: |
yarn install
yarn run test
- save_cache:
paths:
- ~/.m2
- ~/.yarn
- ~/.gitlibs
- ~/.cache/ms-playwright
key: v1-dependencies-{{ checksum "common/deps.edn"}}-{{ checksum "common/yarn.lock" }}
key: v1-dependencies-{{ checksum "common/deps.edn"}}
test-frontend:
docker:
@@ -105,36 +61,36 @@ jobs:
# Download and cache dependencies
- restore_cache:
keys:
- v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
- v1-dependencies-{{ checksum "frontend/deps.edn"}}
- run:
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
name: "prepopulate linter cache"
working_directory: "./common"
command: |
yarn install
yarn run playwright install chromium
yarn run lint:clj
- run:
name: "lint scss on frontend"
name: "fmt check & linter"
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
- ~/.yarn
- ~/.gitlibs
- ~/.cache/ms-playwright
key: v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
key: v1-dependencies-{{ checksum "frontend/deps.edn"}}
test-components:
docker:
@@ -153,14 +109,14 @@ jobs:
# Download and cache dependencies
- restore_cache:
keys:
- v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
- v1-dependencies-{{ checksum "frontend/deps.edn"}}
- run:
name: Install dependencies
working_directory: "./frontend"
command: |
yarn install
yarn run playwright install chromium
yarn
npx playwright install --with-deps
- run:
name: Build Storybook
@@ -192,7 +148,7 @@ jobs:
# Download and cache dependencies
- restore_cache:
keys:
- v1-dependencies-{{ checksum "frontend/deps.edn"}}-{{ checksum "frontend/yarn.lock" }}
- v1-dependencies-{{ checksum "frontend/deps.edn"}}
- run:
name: "integration tests"
@@ -202,7 +158,7 @@ jobs:
yarn run build:app:assets
yarn run build:app
yarn run build:app:libs
yarn run playwright install chromium
yarn run playwright install --with-deps chromium
yarn run test:e2e -x --workers=4
test-backend:
@@ -229,6 +185,21 @@ 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"
@@ -244,9 +215,37 @@ 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
@@ -279,27 +278,10 @@ jobs:
workflows:
penpot:
jobs:
- 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-frontend
- test-components
- test-integration
- test-backend
- test-common
- test-exporter
- test-render-wasm

View File

@@ -26,7 +26,7 @@ jobs:
- name: Check Commit Type
uses: gsactions/commit-message-checker@v2
with:
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].*[^.]$'
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].*[^.]$'
flags: 'gm'
error: 'Commit should match CONTRIBUTING.md guideline'
checkAllCommitMessages: 'true' # optional: this checks all commits associated with a pull request

2
.gitignore vendored
View File

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

View File

@@ -6,57 +6,46 @@
### :boom: Breaking changes & Deprecations
**Penpot Library**
**Breaking changes on penpot library:**
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)
- 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.
### :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.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
## 2.7.0 (Unreleased)
### :rocket: Epics and highlights
@@ -74,10 +63,10 @@ on [its own changelog](library/CHANGES.md)
- 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)
@@ -104,13 +93,6 @@ on [its own changelog](library/CHANGES.md)
- 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

View File

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

View File

@@ -1,59 +1,62 @@
# Contributing Guide #
Thank you for your interest in contributing to Penpot. This is a
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/).
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.
## Reporting Bugs ##
We are using [GitHub Issues](https://github.com/penpot/penpot/issues)
for our public bugs. We keep a close eye on them and try to make it
for our public bugs. We keep a close eye on this 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
- the browser and browser version used
- a dev tools console exception stack trace (if available)
- a browser and the browser version used
- a dev tools console exception stack trace (if it is available)
If you found a bug which you think is better to discuss in private (for
example, security bugs), consider first sending an email to
If you found a bug that you consider better discuss in private (for
example: security bugs), consider first send an email to
`support@penpot.app`.
**We don't have a formal bug bounty program for security reports; this
is an open source application, and your contribution will be recognized
**We don't have 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 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 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 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
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
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 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 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 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)
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.
We use the `easy fix` tag to indicate issues that are appropriate for beginners.
## Commit Guidelines ##
We have very precise rules on how our git commit messages must be formatted.
We have very precise rules over how our git commit messages can be formatted.
The commit message format is:
@@ -68,37 +71,34 @@ The commit message format is:
Where type is:
- :bug: `:bug:` a commit that fixes a bug
- :sparkles: `:sparkles:` a commit that adds an improvement
- :tada: `:tada:` a commit with a new feature
- :sparkles: `:sparkles:` a commit that an improvement
- :tada: `:tada:` a commit with new feature
- :recycle: `:recycle:` a commit that introduces a refactor
- :lipstick: `:lipstick:` a commit with cosmetic changes
- :ambulance: `:ambulance:` a commit that fixes a critical bug
- :ambulance: `:ambulance:` a commit that fixes 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 non-relevant changes
- :arrow_up: `:arrow_up:` a commit with dependency updates
- :arrow_down: `:arrow_down:` a commit with dependency downgrades
- :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
- :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 the imperative mood.
- The subject should capitalize the first letter, omit the period
at the end, and be no longer than 65 characters.
- 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 blank line between the subject line and the body.
- An entry in the CHANGES.md file if applicable, referencing the
GitHub or Taiga issue/user story using these same rules.
- An entry on the CHANGES.md file if applicable, referencing the
github or taiga issue/user-story using the these same rules.
Examples of good commit messages:
@@ -111,30 +111,8 @@ Examples of good commit messages:
- `:ambulance: Fix critical bug on user registration process`
- `:tada: Add new approach for user registration`
## Formatting and Linting ##
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 ##
## Code of conduct ##
As contributors and maintainers of this project, we pledge to respect
all people who contribute through reporting issues, posting feature
@@ -154,11 +132,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 with this Code of Conduct. Project
contributions that are not aligned to 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.
@@ -167,11 +145,12 @@ 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/](http://contributor-covenant.org/version/1/1/0/)
1.1.0, available from http://contributor-covenant.org/version/1/1/0/
## Developer's Certificate of Origin (DCO)
By submitting code you agree to and can certify the following:
## Developer's Certificate of Origin (DCO) ##
By submitting code you are agree and can certify the below:
Developer's Certificate of Origin 1.1
@@ -199,15 +178,13 @@ By submitting code you agree to and can certify the following:
maintained indefinitely and may be redistributed consistent with
this project or the open source license(s) involved.
Then, all your code patches (**documentation is excluded**) should
Then, all your code patches (**documentation are excluded**) should
contain a sign-off at the end of the patch/commit description body. It
can be automatically added by adding the `-s` parameter to `git commit`.
can be automatically added on adding `-s` parameter to `git commit`.
This is an example of what the line should look like:
This is an example of the aspect of the line:
```
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).

View File

@@ -34,7 +34,7 @@
<br />
[Penpot video](https://github.com/user-attachments/assets/08b83119-c090-4a74-86ed-7bfbdda9a793)
[Penpot video](https://github.com/penpot/penpot/assets/5446186/b8ad0764-585e-4ddc-b098-9b4090d337cc)
<br />
@@ -93,9 +93,10 @@ With Penpots standardized [design tokens](https://penpot.dev/collaboration/de
## Getting started ##
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.
### Install with Elestio ###
Penpot is the only design & prototype platform that is deployment agnostic. You can use it or deploy it anywhere.
Learn how to install it with Docker, Kubernetes, Elestio or other options on [our website](https://penpot.app/self-host).
Learn how to install it with Elestio and Docker, or other options on [our website](https://penpot.app/self-host).
<br />
<p align="center">
@@ -127,12 +128,6 @@ 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?

View File

@@ -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.7-3"}
com.github.luben/zstd-jni {:mvn/version "1.5.6-9"}
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.6.0.RELEASE"}
io.lettuce/lettuce-core {:mvn/version "6.5.2.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.1002"}
metosin/reitit-core {:mvn/version "0.8.0"}
{:mvn/version "1.3.994"}
metosin/reitit-core {:mvn/version "0.7.2"}
nrepl/nrepl {:mvn/version "1.3.1"}
cider/cider-nrepl {:mvn/version "0.55.7"}
cider/cider-nrepl {:mvn/version "0.52.0"}
org.postgresql/postgresql {:mvn/version "42.7.5"}
org.xerial/sqlite-jdbc {:mvn/version "3.49.1.0"}
org.xerial/sqlite-jdbc {:mvn/version "3.48.0.0"}
com.zaxxer/HikariCP {:mvn/version "6.3.0"}
com.zaxxer/HikariCP {:mvn/version "6.2.1"}
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.20.1"}
org.jsoup/jsoup {:mvn/version "1.18.3"}
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.3"}
markdown-clj/markdown-clj {:mvn/version "1.12.2"}
;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
software.amazon.awssdk/s3 {:mvn/version "2.31.48"}}
software.amazon.awssdk/s3 {:mvn/version "2.28.26"}}
:paths ["src" "resources" "target/classes"]
:aliases
@@ -74,7 +74,7 @@
:build
{:extra-deps
{io.github.clojure/tools.build {:git/tag "v0.10.9" :git/sha "e405aac"}}
{io.github.clojure/tools.build {:git/tag "v0.10.6" :git/sha "52cf7d6"}}
:ns-default build}
:test

View File

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

View File

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

View File

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

View File

@@ -53,7 +53,6 @@
(* 1024 1024 100))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare get-resolved-file-libraries)
(def file-attrs
#{:id
@@ -144,13 +143,11 @@
(reduce #(index-object %1 %2 attr) index coll)))
(defn decode-row
[{: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)))))
"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))))
(defn decode-file
"A general purpose file decoding function that resolves all external
@@ -159,8 +156,7 @@
(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))
libs (delay (get-resolved-file-libraries cfg file))]
(feat.fdata/resolve-file-data cfg))]
(-> file
(update :features db/decode-pgarray #{})
@@ -168,7 +164,7 @@
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(update :data assoc :id id)
(fmg/migrate-file libs)))))
(fmg/migrate-file)))))
(defn get-file
"Get file, resolve all features and apply migrations.
@@ -422,27 +418,26 @@
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
(defn process-file
[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)
[{: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))))
;; 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}]
@@ -533,49 +528,3 @@
(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)))

View File

@@ -10,6 +10,7 @@
[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]))
@@ -27,11 +28,13 @@
(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"
nil
(feat.compv2/migrate-file! cfg file-id
:validate? (::validate cfg true)
:skip-on-graphic-error? true)
"fdata/shape-data-type"
nil

View File

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

View File

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

View File

@@ -18,7 +18,6 @@
[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]
@@ -74,7 +73,7 @@
[:size ::sm/int]
[:content-type :string]
[:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
[:hash {:optional true} :string]])
[:hash :string]])
(def ^:private schema:file-thumbnail
[:map {:title "FileThumbnail"}
@@ -89,19 +88,13 @@
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/schema:page sm/json-transformer))
(sm/encoder ::ctp/page sm/json-transformer))
(def encode-shape
(sm/encoder ::cts/shape sm/json-transformer))
@@ -136,7 +129,7 @@
(sm/decoder schema:manifest sm/json-transformer))
(def decode-media
(sm/decoder ctf/schema:media sm/json-transformer))
(sm/decoder ::ctf/media sm/json-transformer))
(def decode-component
(sm/decoder ::ctc/component sm/json-transformer))
@@ -236,13 +229,27 @@
: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 (cmedia/mtype->extension (:content-type smeta))
ext (resolve-extension (:content-type smeta))
path (str "objects/" id ".json")
params (-> (meta sobject)
(assoc :id (:id sobject))
@@ -567,13 +574,7 @@
(let [object (->> (read-entry input entry)
(decode-media)
(validate-media))
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))]
object (assoc object :file-id file-id)]
(if (= id (:id object))
(conj result object)
result)))
@@ -754,9 +755,8 @@
(assoc :data data)
(assoc :name file-name)
(assoc :project-id project-id)
(dissoc :options))
file (bfc/process-file cfg file)]
(dissoc :options)
(bfc/process-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 (cmedia/mtype->extension (:content-type object))
(let [ext (resolve-extension (:content-type object))
path (str "objects/" id ext)
content (->> path
(get-zip-entry input)
@@ -814,14 +814,13 @@
:expected-size (:size object)
:found-size (sto/get-size 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))))
(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)))
(let [params (-> object
(dissoc :id :size)

View File

File diff suppressed because it is too large Load Diff

View File

@@ -1,31 +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.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)))

View File

@@ -9,6 +9,7 @@
(: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]
@@ -53,20 +54,18 @@
::yres/status 200
::yres/body (yres/stream-body
(fn [_ output]
(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]
(binding [events/*channel* (sp/chan :buf buf :xf (keep encode))]
(let [listener (events/start-listener
(partial write! output)
(partial pu/close! output))]
(try
(let [result (handler)]
(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))))))}))
(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)))))))}))

View File

@@ -8,11 +8,12 @@
"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]
@@ -21,38 +22,39 @@
[buddy.core.bytes :as bb]
[buddy.core.codecs :as bc]
[clojure.java.shell :as sh]
[clojure.xml :as xml]
[clojure.spec.alpha :as s]
[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))
(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 ::path fs/path?)
(s/def ::filename string?)
(s/def ::size integer?)
(s/def ::headers (s/map-of string? string?))
(s/def ::mtype string?)
(def ^:private schema:input
[:map {:title "Input"}
[:path ::fs/path]
[:mtype {:optional true} ::sm/text]])
(s/def ::upload
(s/keys :req-un [::filename ::size ::path]
:opt-un [::mtype ::headers]))
(def ^:private check-input
(sm/check-fn schema:input))
;; 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]]])
(defn validate-media-type!
([upload] (validate-media-type! upload cm/valid-image-types))
@@ -95,44 +97,17 @@
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 ::width integer?)
(s/def ::height integer?)
(s/def ::format #{:jpeg :webp :png})
(s/def ::quality #(< 0 % 101))
(def ^:private check-thumbnail-params
(sm/check-fn schema:thumbnail-params))
(s/def ::thumbnail-params
(s/keys :req-un [::input ::format ::width ::height]))
;; Related info on how thumbnails generation
;; http://www.imagemagick.org/Usage/thumbnails/
@@ -154,38 +129,30 @@
:data tmp)))
(defmethod process :generic-thumbnail
[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))))
[{: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))))
(defmethod process :profile-thumbnail
[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))))
[{: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))))
(defn get-basic-info-from-svg
[{:keys [tag attrs] :as data}]
@@ -217,9 +184,10 @@
(defmethod process :info
[{:keys [input] :as params}]
(let [{:keys [path mtype] :as input} (check-input input)]
(us/assert ::input input)
(let [{:keys [path mtype]} input]
(if (= mtype "image/svg+xml")
(let [info (some-> path slurp parse-svg get-basic-info-from-svg)]
(let [info (some-> path slurp csvg/parse get-basic-info-from-svg)]
(when-not info
(ex/raise :type :validation
:code :invalid-svg-file

View File

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

View File

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

View File

@@ -6,7 +6,6 @@
(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]
@@ -24,7 +23,6 @@
[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]
@@ -191,7 +189,7 @@
[:is-shared ::sm/boolean]
[:project-id ::sm/uuid]
[:created-at ::dt/instant]
[:data {:optional true} ::sm/any]])
[:data {:optional true} :any]])
(def schema:permissions-mixin
[:map {:title "PermissionsMixin"}
@@ -213,8 +211,7 @@
[{: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 [libs (delay (bfc/get-resolved-file-libraries cfg file))
;; For avoid unnecesary overhead of creating multiple pointers and
(let [;; 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
@@ -222,7 +219,7 @@
file (-> file
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(fmg/migrate-file libs))]
(fmg/migrate-file))]
(if (or read-only? (db/read-only? conn))
file
@@ -618,6 +615,44 @@
;; --- 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]])
@@ -629,7 +664,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)
(bfc/get-file-libraries conn file-id)))
(get-file-libraries conn file-id)))
;; --- COMMAND QUERY: Files that use this File library
@@ -935,13 +970,12 @@
;; --- MUTATION COMMAND: delete-file
(defn- mark-file-deleted
[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]})]
[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]})]
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :file
@@ -957,11 +991,7 @@
(defn- delete-file
[{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
(check-edition-permissions! conn profile-id id)
(let [team (teams/get-team conn
:profile-id profile-id
:file-id id)
file (mark-file-deleted conn team id)]
(let [file (mark-file-deleted conn id)]
(rph/with-meta (rph/wrap)
{::audit/props {:project-id (:project-id file)
:name (:name file)

View File

@@ -14,6 +14,7 @@
[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]
@@ -109,7 +110,7 @@
;; --- MUTATION COMMAND: persist-temp-file
(defn persist-temp-file
[{:keys [::db/conn] :as cfg} {:keys [id] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [id ::rpc/profile-id] :as params}]
(let [file (files/get-file cfg id
:migrate? false
:lock-for-update? true)]
@@ -118,6 +119,7 @@
(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]]})
@@ -145,6 +147,19 @@
: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

View File

@@ -20,7 +20,6 @@
[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]
@@ -210,7 +209,7 @@
Only intended for internal use on this module."
[{:keys [::db/conn ::wrk/executor ::timestamp] :as cfg}
{:keys [profile-id file team features changes session-id skip-validate] :as params}]
{:keys [profile-id file features changes session-id skip-validate] :as params}]
(let [;; Retrieve the file data
file (feat.fmigr/resolve-applied-migrations cfg file)
@@ -244,7 +243,7 @@
:created-at timestamp
:updated-at timestamp
:deleted-at (if (::snapshot-data file)
(dt/plus timestamp (ldel/get-deletion-delay team))
(dt/plus timestamp (cf/get-deletion-delay))
(dt/plus timestamp (dt/duration {:hours 1})))
:file-id (:id file)
:revn (:revn file)
@@ -341,7 +340,6 @@
(-> 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
@@ -352,7 +350,7 @@
(-> file
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(fmg/migrate-file libs))
(fmg/migrate-file))
file)
file (apply update-fn cfg file args)
@@ -381,6 +379,13 @@
(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]
@@ -406,7 +411,7 @@
(when (and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
(bfc/get-resolved-file-libraries cfg file))
(get-file-libraries cfg file))
;; The main purpose of this atom is provide a contextual state

View File

@@ -12,7 +12,6 @@
[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]
@@ -81,9 +80,9 @@
(def ^:private schema:create-font-variant
[:map {:title "create-font-variant"}
[:team-id ::sm/uuid]
[:data [:map-of ::sm/text ::sm/any]]
[:data [:map-of :string :any]]
[:font-id ::sm/uuid]
[:font-family ::sm/text]
[:font-family :string]
[:font-weight [::sm/one-of {:format "number"} valid-weight]]
[:font-style [::sm/one-of {:format "string"} valid-style]]])
@@ -203,40 +202,32 @@
(sv/defmethod ::delete-font
{::doc/added "1.18"
::webhooks/event? true
::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)
::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)]
fonts (db/query conn :team-font-variant
{:team-id team-id
:font-id id
:deleted-at nil}
{::sql/for-update true})
(when-not (seq fonts)
(ex/raise :type :not-found
:code :object-not-found))
delay (ldel/get-deletion-delay team)
tnow (dt/in-future delay)]
(doseq [font fonts]
(db/update! conn :team-font-variant
{:deleted-at tnow}
{:id (:id font)}))
(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}})))
(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
@@ -248,23 +239,19 @@
(sv/defmethod ::delete-font-variant
{::doc/added "1.18"
::webhooks/event? 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)]
::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})]
(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})
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id (:id variant)})
(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)}})))))

View File

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

View File

@@ -480,7 +480,8 @@
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
AND (t.deleted_at IS NULL OR
t.deleted_at > now())
)
SELECT tpr.team_id AS id,
count(tpr.profile_id) - 1 AS participants

View File

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

View File

@@ -17,7 +17,6 @@
[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]
@@ -115,6 +114,18 @@
;; --- 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,
@@ -149,7 +160,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]
@@ -180,37 +191,6 @@
(->> (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)
@@ -234,43 +214,39 @@
(defn get-team
[conn & {:keys [profile-id team-id project-id file-id] :as params}]
(assert (uuid? profile-id) "profile-id is mandatory")
(assert (or (db/connection? conn)
(db/pool? conn))
"connection or pool is mandatory")
(dm/assert!
"connection or pool is mandatory"
(or (db/connection? conn)
(db/pool? conn)))
(let [{:keys [default-team-id] :as profile}
(profile/get-profile conn profile-id)
(dm/assert!
"profile-id is mandatory"
(uuid? profile-id))
sql
(if (contains? cf/flags :subscriptions)
sql:get-teams-with-permissions-and-subscription
sql:get-teams-with-permissions)
(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]))
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? 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]))
(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]))
(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? 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")))]
:else
(throw (IllegalArgumentException. "invalid arguments")))]
(when-not result
(ex/raise :type :not-found
@@ -658,13 +634,13 @@
(defn- delete-team
"Mark a team for deletion"
[conn {:keys [id] :as team}]
[conn team-id]
(let [delay (ldel/get-deletion-delay team)
team (db/update! conn :team
{:deleted-at (dt/in-future delay)}
{:id id}
{::db/return-keys true})]
(let [deleted-at (dt/now)
team (db/update! conn :team
{:deleted-at deleted-at}
{:id team-id}
{::db/return-keys true})]
(when (:is-default team)
(ex/raise :type :validation
@@ -674,8 +650,8 @@
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :team
:deleted-at (:deleted-at team)
:id id}})
:deleted-at deleted-at
:id team-id}})
team))
(def ^:private schema:delete-team
@@ -687,14 +663,12 @@
::sm/params schema:delete-team
::db/transaction true}
[{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(let [team (get-team conn :profile-id profile-id :team-id id)
perms (get team :permissions)]
(let [perms (get-permissions conn profile-id id)]
(when-not (:is-owner perms)
(ex/raise :type :validation
:code :only-owner-can-delete-team))
(delete-team conn team)
(delete-team conn id)
nil))
;; --- Mutation: Team Update Role

View File

@@ -6,7 +6,6 @@
(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]
@@ -79,7 +78,7 @@
:always
(update :data select-keys [:id :options :pages :pages-index :components]))
libs (->> (bfc/get-file-libraries conn file-id)
libs (->> (files/get-file-libraries conn file-id)
(mapv (fn [{:keys [id] :as lib}]
(merge lib (files/get-file cfg id)))))

View File

@@ -9,7 +9,6 @@
(: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]
@@ -20,6 +19,7 @@
[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,7 +178,8 @@
(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})))
@@ -208,7 +209,7 @@
(defmethod ig/init-key ::routes
[_ {:keys [::rpc/methods] :as cfg}]
[(let [context (delay (prepare-doc-context methods))]
[(let [context (prepare-doc-context methods)]
[["/_doc"
{:handler (doc-handler context)
:allowed-methods #{:get}}]
@@ -216,7 +217,7 @@
{:handler (doc-handler context)
:allowed-methods #{:get}}]])
(let [context (delay (prepare-openapi-context methods))]
(let [context (prepare-openapi-context methods)]
[["/openapi"
{:handler (openapi-handler)
:allowed-methods #{:get}}]

View File

@@ -0,0 +1,306 @@
;; 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))))))

View File

@@ -13,6 +13,7 @@
[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]
@@ -61,27 +62,6 @@
{: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]
@@ -116,7 +96,7 @@
(defn take-team-snapshot!
[system team-id label]
(let [conn (db/get-connection system)]
(->> (get-and-lock-team-files conn team-id)
(->> (feat.comp-v2/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
@@ -128,16 +108,19 @@
(defn restore-team-snapshot!
[system team-id label]
(let [conn (db/get-connection system)
ids (->> (get-and-lock-team-files conn team-id)
ids (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(into #{}))
snap (search-file-snapshots conn ids label)
ids' (into #{} (map :file-id) snap)]
ids' (into #{} (map :file-id) snap)
team (-> (feat.comp-v2/get-team conn team-id)
(update :features disj "components/v2"))]
(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))
@@ -146,9 +129,13 @@
(defn process-file!
[system file-id update-fn & {:keys [label validate? with-libraries?] :or {validate? true} :as opts}]
(let [file (bfc/get-file system file-id ::db/for-update true)
(let [conn (db/get-connection system)
file (bfc/get-file system file-id ::db/for-update true)
libs (when with-libraries?
(bfc/get-resolved-file-libraries system file))
(->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(bfc/get-file system id))))
(d/index-by :id)))
file' (when file
(if with-libraries?

View File

@@ -22,6 +22,7 @@
[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]
@@ -390,9 +391,12 @@
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! (assoc main/system ::db/rollback true)
(fn [system]
(let [file (bfc/get-file system file-id)
libs (bfc/get-resolved-file-libraries system file)]
(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))]
(cfv/validate-file file libs))))))
(defn repair-file!
@@ -435,7 +439,7 @@
(binding [h/*system* system
db/*conn* (db/get-connection system)]
(->> (h/get-and-lock-team-files conn team-id)
(->> (feat.comp-v2/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)

View File

@@ -9,6 +9,7 @@
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]
@@ -17,15 +18,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-profiles deletion-threshold chunk-size] {:fetch-size 5})
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-profiles min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id]}]
(l/trc :hint "permanently delete" :rel "profile" :id (str id))
@@ -40,15 +41,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-teams deletion-threshold chunk-size] {:fetch-size 5})
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-teams min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "team"
@@ -68,15 +69,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-fonts deletion-threshold chunk-size] {:fetch-size 5})
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-fonts min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
(l/trc :hint "permanently delete"
:rel "team-font-variant"
@@ -100,15 +101,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 ::deletion-threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-projects deletion-threshold chunk-size] {:fetch-size 5})
[{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-projects min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "project"
@@ -126,15 +127,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 ::deletion-threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-files deletion-threshold chunk-size] {:fetch-size 5})
[{:keys [::db/conn ::sto/storage ::min-age ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-files min-age chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id deleted-at project-id] :as file}]
(l/trc :hint "permanently delete"
:rel "file"
@@ -155,15 +156,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-thumbnails deletion-threshold chunk-size] {:fetch-size 5})
[{: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})
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-thumbnail"
@@ -184,15 +185,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-object-thumbnails deletion-threshold chunk-size] {:fetch-size 5})
[{: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})
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-tagged-object-thumbnail"
@@ -213,15 +214,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 ::deletion-threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-file-data-fragments deletion-threshold chunk-size] {:fetch-size 5})
[{: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})
(reduce (fn [total {:keys [file-id id deleted-at data-ref-id]}]
(l/trc :hint "permanently delete"
:rel "file-data-fragment"
@@ -239,15 +240,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-media-objects deletion-threshold chunk-size] {:fetch-size 5})
[{: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})
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
(l/trc :hint "permanently delete"
:rel "file-media-object"
@@ -268,15 +269,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 ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-change deletion-threshold chunk-size] {:fetch-size 5})
[{: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})
(reduce (fn [total {:keys [id file-id deleted-at] :as xlog}]
(l/trc :hint "permanently delete"
:rel "file-change"
@@ -323,13 +324,16 @@
(defmethod ig/expand-key ::handler
[k v]
{k (assoc v ::chunk-size 100)})
{k (assoc v
::min-age (cf/get-deletion-delay)
::chunk-size 100)})
(defmethod ig/init-key ::handler
[_ cfg]
(fn [{:keys [props] :as task}]
(let [threshold (dt/duration (get props :deletion-threshold 0))
cfg (assoc cfg ::deletion-threshold (db/interval threshold))]
(let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
cfg (assoc cfg ::min-age (db/interval min-age))]
(loop [procs (map deref deletion-proc-vars)
total 0]
(if-let [proc-fn (first procs)]

View File

@@ -10,6 +10,7 @@
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]
@@ -17,30 +18,33 @@
(def ^:dynamic *channel* nil)
(defn channel
[]
(sp/chan :buf 32))
(defn tap
([type data]
(when-let [channel *channel*]
(sp/put! channel [type data])
nil))
([channel type data]
(when channel
(sp/put! channel [type data])
nil)))
[type data]
(when-let [channel *channel*]
(sp/put! channel [type data])
nil))
(defn start-listener
[channel on-event on-close]
(assert (sp/chan? channel) "expected active events channel")
[on-event on-close]
(dm/assert!
"expected active events channel"
(sp/chan? *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)))))
@@ -51,7 +55,7 @@
[f on-event]
(binding [*channel* (sp/chan :buf 32)]
(let [listener (start-listener *channel* on-event (constantly nil))]
(let [listener (start-listener on-event (constantly nil))]
(try
(f)
(finally

View File

@@ -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))

View File

@@ -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,27 +123,8 @@
:components-v2 true}
out (th/command! data)]
;; (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))
@@ -214,7 +195,7 @@
(t/is (= 5 (count rows))))
;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 3 (:processed res))))
;; Check the number of fragments
@@ -249,7 +230,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 3 (:processed res))))
;; Check the number of fragments;
@@ -273,7 +254,7 @@
(t/is (= 4 (count rows)))
(t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@@ -374,7 +355,7 @@
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 3 (:processed res))))
;; check file media objects
@@ -405,7 +386,7 @@
;; This only clears fragments, the file media objects still referenced because
;; snapshots are preserved
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
;; Mark all snapshots to be a non-snapshot file change
@@ -414,7 +395,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
;; Now that file-gc have deleted the file-media-object usage,
@@ -527,7 +508,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)
@@ -569,7 +550,7 @@
;; This only removes unused fragments, file media are still
;; referenced on snapshots.
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
;; Mark all snapshots to be a non-snapshot file change
@@ -579,7 +560,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 6 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)
@@ -731,7 +712,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 5 (:processed res))))
;; Now that objects-gc have deleted the object thumbnail lets
@@ -760,7 +741,7 @@
(t/is (= 1 (count rows)))
(t/is (= 0 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
;; (pp/pprint res)
(t/is (= 3 (:processed res))))
@@ -895,7 +876,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 {})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed result))))
;; query the list of files
@@ -926,7 +907,7 @@
(t/is (= 0 (count result)))))
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result))))
;; query the list of file libraries of a after hard deletion
@@ -940,7 +921,7 @@
(t/is (= 0 (count result)))))
;; run permanent deletion
(let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
;; query the list of file libraries of a after hard deletion
@@ -1195,7 +1176,7 @@
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 4 (:processed res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
@@ -1251,7 +1232,7 @@
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
@@ -1270,7 +1251,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 {})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
;; Check the number of fragments before adding the page
@@ -1291,7 +1272,7 @@
(th/run-pending-tasks!))
;; Clean objects after file-gc
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
;; Check the number of fragments before adding the page
@@ -1343,7 +1324,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 {})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
;; Check the number of fragments before adding the page
@@ -1731,7 +1712,6 @@
[{:fill-image
{:id (:id fmedia)
:name "test"
:mtype "image/jpeg"
:width 200
:height 200}}]]
@@ -1840,7 +1820,8 @@
(t/is (= (:id file-2) (:file-id (get rows 1))))
(t/is (nil? (:deleted-at (get rows 1)))))
(th/run-task! :objects-gc {})
(th/run-task! :objects-gc
{:min-age 0})
(let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
(t/is (= 1 (count rows)))

View File

@@ -7,7 +7,6 @@
(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]
@@ -145,7 +144,7 @@
(t/is (= 0 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
@@ -205,7 +204,7 @@
(t/is (= 0 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
@@ -264,7 +263,7 @@
(t/is (= 0 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]

View File

@@ -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)))))))

View File

@@ -7,7 +7,6 @@
(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]
@@ -179,7 +178,7 @@
;; project is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed result))))
;; query the list of projects
@@ -211,7 +210,7 @@
(t/is (= 1 (count result)))))
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result))))
;; query the list of files of a after soft deletion
@@ -225,7 +224,7 @@
(t/is (= 0 (count result)))))
;; run permanent deletion
(let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
;; query the list of files of a after hard deletion

View File

@@ -8,7 +8,6 @@
(: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]
@@ -450,23 +449,6 @@
(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)})
@@ -477,7 +459,7 @@
;; team is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 0 (:processed result))))
;; query the list of teams
@@ -511,7 +493,7 @@
(th/run-pending-tasks!)
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {})]
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result))))
;; query the list of projects after hard deletion
@@ -525,7 +507,7 @@
(t/is (= :not-found (:type edata)))))
;; run permanent deletion
(let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 2 (:processed result))))
;; query the list of projects of a after hard deletion
@@ -539,6 +521,7 @@
(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))
@@ -581,7 +564,7 @@
(t/is (= 1 (count rows)))
(t/is (dt/instant? (:deleted-at (first rows)))))
(let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 5 (:processed result))))))
(t/deftest create-team-access-request

View File

@@ -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.17"}
org.slf4j/slf4j-api {:mvn/version "2.0.16"}
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
selmer/selmer {:mvn/version "1.12.62"}
selmer/selmer {:mvn/version "1.12.61"}
criterium/criterium {:mvn/version "0.4.6"}
metosin/jsonista {:mvn/version "0.3.13"}
metosin/malli {:mvn/version "0.18.0"}
metosin/malli {:mvn/version "0.17.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 "2025.05.26-411"}
funcool/cuerdas {:mvn/version "2023.11.09-407"}
funcool/promesa
{:git/sha "f52f58cfacf62f59eab717e2637f37729d0cc383"
{:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
: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.5"}
thheller/shadow-cljs {:mvn/version "3.0.3"}
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.9" :git/sha "e405aac"}}
{io.github.clojure/tools.build {:git/tag "v0.10.6" :git/sha "52cf7d6"}}
: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"]
:jvm-opts ["--sun-misc-unsafe-memory-access=allow"]}
{:main-opts ["-m" "shadow.cljs.devtools.cli"]}
:outdated
{:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
:main-opts ["-m" "antq.core"]}}}

View File

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

View File

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

View File

@@ -10,21 +10,20 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.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.comp]
[app.common.types.container :as types.cont]
[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.file :as types.file]
[app.common.types.page :as types.page]
[app.common.types.path :as types.path]
[app.common.types.pages-list :as types.pages-list]
[app.common.types.shape :as types.shape]
[app.common.types.typography :as types.typography]
[app.common.uuid :as uuid]
@@ -38,36 +37,41 @@
(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
[state name]
(let [container-id (::current-page-id state)]
(update-in state [::unames container-id] conjs name)))
[file name]
(let [container-id (::current-page-id file)]
(update-in file [::unames container-id] conjs name)))
(defn- commit-change
[state change & {:keys [add-container]}]
(let [file-id (get state ::current-file-id)]
(assert (uuid? file-id) "no current file id")
[file change & {:keys [add-container]
:or {add-container false}}]
(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))))
(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]))
(defn- commit-shape
[state shape]
[file shape]
(let [parent-id
(-> state ::parent-stack peek)
(-> file ::parent-stack peek)
frame-id
(get state ::current-frame-id)
(::current-frame-id file)
page-id
(get state ::current-page-id)
(::current-page-id file)
change
{:type :add-obj
@@ -78,31 +82,39 @@
:frame-id frame-id
:page-id page-id}]
(-> state
(-> file
(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 state]
(let [container-id (::current-page-id state)
unames (dm/get-in state [:unames container-id])]
[name file]
(let [container-id (::current-page-id file)
unames (dm/get-in file [:unames container-id])]
(d/unique-name name (or unames #{}))))
(defn- clear-names [file]
(dissoc file ::unames))
(defn- assign-shape-name
(defn- assign-name
"Given a tag returns its layer name"
[shape state]
(cond-> shape
(nil? (:name shape))
(assoc :name (let [type (get shape :type)]
(case type
:frame "Board"
(str/capital (d/name type)))))
[data file type]
(cond-> data
(nil? (:name data))
(assoc :name (generate-name type data))
:always
(update :name unique-name state)))
(update :name unique-name file)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMAS
@@ -123,21 +135,20 @@
(def decode-library-typography
(sm/decode-fn types.typography/schema:typography sm/json-transformer))
(def schema:add-component
(def decode-component
(sm/decode-fn types.component/schema:component sm/json-transformer))
(def schema:add-component-instance
[:map
[:component-id ::sm/uuid]
[: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]])
[:x ::sm/safe-number]
[:y ::sm/safe-number]])
(def ^:private check-add-component
(sm/check-fn schema:add-component
:hint "invalid arguments passed for add-component"))
(def check-add-component-instance
(sm/check-fn schema:add-component-instance))
(def decode-add-component
(sm/decode-fn schema:add-component sm/json-transformer))
(def decode-add-component-instance
(sm/decode-fn schema:add-component-instance sm/json-transformer))
(def schema:add-bool
[:map
@@ -147,97 +158,37 @@
(def decode-add-bool
(sm/decode-fn schema:add-bool sm/json-transformer))
(def ^:private check-add-bool
(def 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 create-state
[]
{})
(defn get-current-page
[state]
(let [file-id (get state ::current-file-id)
page-id (get state ::current-page-id)]
(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)
(defn lookup-shape [file shape-id]
(-> (lookup-objects file)
(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
(defn get-current-page
[file]
(let [page-id (::current-page-id file)]
(dm/get-in file [:data :pages-index page-id])))
(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]
(defn create-file
[params]
(let [params (-> params
(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))
(assoc :features cfeat/default-features)
(assoc :migrations fmig/available-migrations))]
(types.file/make-file params :create-page false)))
(defn add-page
[state params]
[file params]
(let [page (-> (types.page/make-empty-page params)
(types.page/check-page))
change {:type :add-page
:page page}]
(-> state
(-> file
(commit-change change)
;; Current page being edited
@@ -252,234 +203,215 @@
;; Last object id added
(assoc ::last-id nil))))
(defn close-page [state]
(-> state
(defn close-page [file]
(-> file
(dissoc ::current-page-id)
(dissoc ::parent-stack)
(dissoc ::last-id)
(clear-names)))
(defn add-board
[state params]
(defn add-artboard
[file data]
(let [{:keys [id] :as shape}
(-> params
(-> data
(update :id default-uuid)
(assoc :type :frame)
(assign-shape-name state)
(assign-name file :frame)
(types.shape/setup-shape)
(types.shape/check-shape))]
(-> state
(-> file
(commit-shape shape)
(update ::parent-stack conjv id)
(assoc ::current-frame-id id)
(assoc ::last-id id))))
(defn close-board
[state]
(let [parent-id (-> state ::parent-stack peek)
parent (get-shape state parent-id)]
(-> state
(defn close-artboard
[file]
(let [parent-id (-> file ::parent-stack peek)
parent (lookup-shape file parent-id)]
(-> file
(assoc ::current-frame-id (or (:frame-id parent) root-id))
(update ::parent-stack pop))))
(defn add-group
[state params]
[file params]
(let [{:keys [id] :as shape}
(-> params
(update :id default-uuid)
(assoc :type :group)
(assign-shape-name state)
(assign-name file :group)
(types.shape/setup-shape)
(types.shape/check-shape))]
(-> state
(-> file
(commit-shape shape)
(assoc ::last-id id)
(update ::parent-stack conjv id))))
(defn close-group
[state]
(let [group-id (-> state ::parent-stack peek)
group (get-shape state group-id)
[file]
(let [group-id (-> file :parent-stack peek)
group (lookup-shape file group-id)
children (->> (get group :shapes)
(into [] (keep (partial get-shape state)))
(into [] (keep (partial lookup-shape file)))
(not-empty))]
(assert (some? children) "group expect to have at least 1 children")
(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}]}]
(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}]}]
(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))))))
(commit-change file change :add-container true)))]
(update file ::parent-stack pop))))
(defn add-bool
[state params]
[file params]
(let [{:keys [group-id type]}
(check-add-bool params)
group
(get-shape state group-id)
(lookup-shape file group-id)
objects
(get-current-objects state)
children
(->> (get group :shapes)
(not-empty))]
bool
(-> group
(assoc :type :bool)
(assoc :bool-type type)
(update-bool-style-properties objects)
(types.path/update-bool-shape objects))
(assert (some? children) "expect group to have at least 1 element")
selrect
(get bool :selrect)
(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}]}]
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))))
(-> file
(commit-change change :add-container true)
(assoc ::last-id group-id)))))
(defn add-shape
[state params]
[file params]
(let [obj (-> params
(d/update-when :svg-attrs csvg/attrs->props)
(types.shape/setup-shape)
(assign-shape-name state))]
(-> state
(assign-name file :type))]
(-> file
(commit-shape obj)
(assoc ::last-id (:id obj)))))
(defn add-library-color
[state color]
[file 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}]
(-> state
(-> file
(commit-change change)
(assoc ::last-id (:id color)))))
(defn add-library-typography
[state typography]
[file typography]
(let [typography (-> typography
(update :id default-uuid)
(d/without-nils))
change {:type :add-typography
:id (:id typography)
:typography typography}]
(-> state
(-> file
(commit-change change)
(assoc ::last-id (:id typography)))))
(defn add-component
[state params]
(let [{:keys [component-id file-id page-id frame-id name path]}
(-> (check-add-component params)
(update :component-id default-uuid))
[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)}
file-id
(or file-id (::current-file-id state))
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)
page-id
(or page-id (get state ::current-page-id))
(get file ::current-page-id)]
frame-id
(or frame-id (get state ::current-frame-id))
(assert (uuid? page-id) "page-id is expected to be set")
(assert (uuid? component) "component is expected to exist")
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})
;; 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)
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}]}]
[shape shapes]
(types.container/make-component-instance page component id pos)
(-> state
(commit-change change1)
(commit-change change2))))
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)))))
(defn delete-shape
[file id]
@@ -491,12 +423,10 @@
:id id}))
(defn update-shape
[state shape-id f]
(let [page-id (get state ::current-page-id)
objects (get-current-objects state)
[file shape-id f]
(let [page-id (::current-page-id file)
objects (lookup-objects file)
old-shape (get objects shape-id)
new-shape (f old-shape)
attrs (d/concat-set
(keys old-shape)
@@ -510,7 +440,7 @@
changes
(conj changes {:type :set :attr attr :val new-val :ignore-touched true}))))]
(-> state
(-> file
(commit-change
{:type :mod-obj
:operations (reduce generate-operation [] attrs)
@@ -519,12 +449,12 @@
(assoc ::last-id shape-id))))
(defn add-guide
[state guide]
[file guide]
(let [guide (cond-> guide
(nil? (:id guide))
(update :id default-uuid))
page-id (::current-page-id state)]
(-> state
(assoc :id (uuid/next)))
page-id (::current-page-id file)]
(-> file
(commit-change
{:type :set-guide
:page-id page-id
@@ -533,56 +463,24 @@
(assoc ::last-id (:id guide)))))
(defn delete-guide
[state id]
(let [page-id (::current-page-id state)]
(commit-change state
[file id]
(let [page-id (::current-page-id file)]
(commit-change file
{:type :set-guide
:page-id page-id
:id id
:params nil})))
(defn update-guide
[state guide]
(let [page-id (::current-page-id state)]
(commit-change state
[file guide]
(let [page-id (::current-page-id file)]
(commit-change file
{:type :set-guide
:page-id page-id
:id (:id guide)
:params guide})))
(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))))
(defn strip-image-extension [filename]
(let [image-extensions-re #"(\.png)|(\.jpg)|(\.jpeg)|(\.webp)|(\.gif)|(\.svg)$"]
(str/replace filename image-extensions-re "")))

View File

@@ -24,7 +24,6 @@
[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]
@@ -48,14 +47,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 ::sm/any]]
[:value [:map-of :keyword :any]]
[:ignore-touched {:optional true} :boolean]
[:ignore-geometry {:optional true} :boolean]]]
[:set
[:map {:title "SetOperation"}
[:type [:= :set]]
[:attr :keyword]
[:val ::sm/any]
[:val :any]
[:ignore-touched {:optional true} :boolean]
[:ignore-geometry {:optional true} :boolean]]]
[:set-touched
@@ -239,9 +238,9 @@
[:component-id {:optional true} ::sm/uuid]
[:ignore-touched {:optional true} :boolean]
[:parent-id ::sm/uuid]
[:shapes ::sm/any]
[:shapes :any]
[:index {:optional true} [:maybe :int]]
[:after-shape {:optional true} ::sm/any]
[:after-shape {:optional true} :any]
[:component-swap {:optional true} :boolean]]]
[:reorder-children
@@ -251,14 +250,14 @@
[:component-id {:optional true} ::sm/uuid]
[:ignore-touched {:optional true} :boolean]
[:parent-id ::sm/uuid]
[:shapes ::sm/any]]]
[:shapes :any]]]
[:add-page
[:map {:title "AddPageChange"}
[:type [:= :add-page]]
[:id {:optional true} ::sm/uuid]
[:name {:optional true} :string]
[:page {:optional true} ::sm/any]]]
[:page {:optional true} :any]]]
[:mod-page
[:map {:title "ModPageChange"}
@@ -311,12 +310,12 @@
[:add-media
[:map {:title "AddMediaChange"}
[:type [:= :add-media]]
[:object ctf/schema:media]]]
[:object ::ctf/media-object]]]
[:mod-media
[:map {:title "ModMediaChange"}
[:type [:= :mod-media]]
[:object ctf/schema:media]]]
[:object ::ctf/media-object]]]
[:del-media
[:map {:title "DelMediaChange"}
@@ -328,14 +327,14 @@
[:type [:= :add-component]]
[:id ::sm/uuid]
[:name :string]
[:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
[:shapes {:optional true} [:vector {:gen/max 3} :any]]
[:path {:optional true} :string]]]
[:mod-component
[:map {:title "ModCompoenentChange"}
[:type [:= :mod-component]]
[:id ::sm/uuid]
[:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
[:shapes {:optional true} [:vector {:gen/max 3} :any]]
[:name {:optional true} :string]
[:variant-id {:optional true} ::sm/uuid]
[:variant-properties {:optional true} [:vector ::ctv/variant-property]]]]
@@ -412,7 +411,7 @@
[:set-tokens-lib
[:map {:title "SetTokensLib"}
[:type [:= :set-tokens-lib]]
[:tokens-lib ::sm/any]]]
[:tokens-lib :any]]]
[:set-token-set
[:map {:title "SetTokenSetChange"}
@@ -426,12 +425,7 @@
[:type [:= :set-token]]
[:set-name :string]
[:token-name :string]
[:token [:maybe ctob/schema:token-attrs]]]]
[:set-base-font-size
[:map {:title "ModBaseFontSize"}
[:type [:= :set-base-font-size]]
[:base-font-size :string]]]]])
[:token [:maybe ctob/schema:token-attrs]]]]]])
(def schema:changes
[:sequential {:gen/max 5 :gen/min 1} schema:change])
@@ -745,7 +739,7 @@
group
(= :bool (:type group))
(path/update-bool-shape group objects)
(gsh/update-bool group objects)
(:masked-group group)
(->> (map lookup children)
@@ -1074,13 +1068,6 @@
(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

View File

@@ -18,26 +18,24 @@
[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)
(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]]))
(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 check-changes!
(sm/check-fn schema:changes))
(sm/check-fn ::changes))
(defn empty-changes
([origin page-id]
@@ -126,41 +124,28 @@
; TODO: remove this when not needed
(defn- assert-page-id!
[changes]
(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"))
(dm/assert!
"Give a page-id or call (with-page) before using this function"
(contains? (meta changes) ::page-id)))
(defn- assert-container-id!
[changes]
(assert
(dm/assert!
"Give a page-id or call (with-container) before using this function"
(or (contains? (meta changes) ::page-id)
(contains? (meta changes) ::component-id))
"Give a page-id or call (with-container) before using this function"))
(contains? (meta changes) ::component-id))))
(defn- assert-objects!
[changes]
(assert
(contains? (meta changes) ::file-data)
"Call (with-objects) before using this function"))
(dm/assert!
"Call (with-objects) before using this function"
(contains? (meta changes) ::file-data)))
(defn- assert-library!
[changes]
(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"))
(dm/assert!
"Call (with-library-data) before using this function"
(contains? (meta changes) ::library-data)))
(defn- lookup-objects
[changes]
@@ -169,9 +154,9 @@
(defn apply-changes-local
[changes & {:keys [apply-to-library?]}]
(assert
(check-changes! changes)
"expected valid changes")
(dm/assert!
"expected valid changes"
(check-changes! changes))
(if-let [file-data (::file-data (meta changes))]
(let [library-data (::library-data (meta changes))
@@ -210,7 +195,6 @@
(defn mod-page
([changes options]
(assert-page! changes)
(let [page (::page (meta changes))]
(mod-page changes page options)))
@@ -241,7 +225,6 @@
([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
@@ -308,8 +291,6 @@
(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])]
@@ -323,11 +304,8 @@
: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])
@@ -346,8 +324,6 @@
(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))
@@ -369,8 +345,6 @@
(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])
@@ -524,7 +498,6 @@
: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)
@@ -686,10 +659,10 @@
(empty? children) ;; a parent with no children will be deleted,
nil ;; so it does not need resize
(cfh/bool-shape? parent)
(path/update-bool-shape parent objects)
(= (:type parent) :bool)
(gsh/update-bool parent objects)
(cfh/group-shape? parent)
(= (:type parent) :group)
;; FIXME: this functions should be
;; normalized in the same way as
;; update-bool in order to make all
@@ -873,7 +846,6 @@
(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
@@ -1163,16 +1135,3 @@
(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))))

View File

@@ -626,9 +626,6 @@
(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)

View File

@@ -31,7 +31,6 @@
[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]))
@@ -59,21 +58,18 @@
(map :name))
(defn migrate
[{:keys [id] :as file} libs]
[{:keys [id] :as file}]
(let [diff
(set/difference available-migrations (:migrations file))
data (-> (:data file)
(assoc :libs libs))
data
(reduce migrate-data data diff)
(reduce migrate-data (:data file) diff)
data
(-> data
(assoc :id id)
(dissoc :version :libs))]
(dissoc :version))]
(-> file
(assoc :data data)
@@ -92,7 +88,7 @@
result))
(defn migrate-file
[file libs]
[file]
(binding [cfeat/*new* (atom #{})]
(let [version (or (:version file)
(-> file :data :version))]
@@ -108,7 +104,7 @@
;; this code from this function that executes on
;; each file migration operation
(update :features cfeat/migrate-legacy-features)
(migrate libs)
(migrate)
(update :features (fnil into #{}) (deref cfeat/*new*))))))
(defn migrated?
@@ -1328,85 +1324,6 @@
(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"
@@ -1465,7 +1382,4 @@
"0002-normalize-bool-content"
"0002-clean-shape-interactions"
"0003-fix-root-shape"
"0003-convert-path-content"
"0004-add-partial-text-touched-flags"
"0005-deprecate-image-type"
"0006-fix-old-texts-fills"]))
"0003-convert-path-content"]))

View File

@@ -8,7 +8,8 @@
[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]))
[app.common.types.variant :as ctv]
[cuerdas.core :as str]))
(defn find-variant-components
@@ -20,6 +21,11 @@
(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]
@@ -36,7 +42,10 @@
(group-by :name)
(map (fn [[k v]]
{:name k
:value (->> v (map :value) distinct)}))))
:value (->> v
(map #(if (str/empty? (:value %)) "--" (:value %)))
distinct
dashes-to-end)}))))
(defn get-variant-mains
[component data]

View File

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

View File

@@ -164,6 +164,7 @@
(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)
@@ -194,7 +195,6 @@
;; Rect
(dm/export grc/rect->points)
(dm/export grc/center->rect)
;;
(dm/export gsff/fit-frame-modifiers)

View File

@@ -346,32 +346,29 @@
center (gco/points->center points)
selrect (calculate-selrect points center)
transform (calculate-transform points center selrect)
inverse (when (some? transform) (gmt/inverse transform))]
[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))]))
(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)
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))))
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
@@ -456,6 +453,13 @@
(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]
@@ -470,7 +474,7 @@
(update-mask-selrect shape children)
(cfh/bool-shape? shape)
(path/update-bool-shape shape objects)
(update-bool shape objects)
(cfh/group-shape? shape)
(update-group-selrect shape children)

View File

@@ -29,7 +29,6 @@
[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]
@@ -597,7 +596,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
@@ -608,7 +607,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
@@ -1664,46 +1663,24 @@
{:type :reg-objects
:shapes all-parents})]))))
(defn- add-update-attr-operations
[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
[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
;; 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= orig-value dest-value)
(not= (get origin-shape attr) (get dest-shape attr))
(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 val
: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))
:ignore-touched true}
uoperation {:type :set
:attr attr
@@ -1712,33 +1689,6 @@
[(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.
@@ -1781,30 +1731,12 @@
:always
(generate-update-tokens container dest-shape origin-shape touched omit-touched?))
(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?)))
(let [attr-group (get ctk/sync-attrs attr)
[roperations' uoperations']
(if skip-operations?
(if (or (= (get origin-shape attr) (get dest-shape attr))
(and (touched attr-group) omit-touched?))
[roperations uoperations]
(add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched text-partial-change?))]
(add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
(recur (next attrs)
roperations'
uoperations')))))))
@@ -1839,7 +1771,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 false))]
(add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
(recur (next attrs)
roperations'
uoperations'))
@@ -2123,8 +2055,7 @@
(pcb/with-objects objects)
(pcb/resize-parents new-objects-ids)
;; Fix the order of the children inside the parent
(cond-> (ctl/any-layout? objects parent-id)
(pcb/reorder-children parent-id (get-in objects [parent-id :shapes]))))]
(pcb/reorder-children parent-id (get-in objects [parent-id :shapes])))]
(assoc changes :file-id library-id)))
(defn generate-detach-component
@@ -2259,9 +2190,7 @@
:starting-frame frame-id}]
(vswap! unames conj name)
(-> changes
(pcb/with-page page)
(pcb/set-flow flow-id new-flow))))
(pcb/set-flow changes flow-id new-flow)))
changes
(->> shapes

View File

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

View File

@@ -60,17 +60,6 @@
(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)

View File

@@ -9,6 +9,21 @@
[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)
@@ -31,56 +46,20 @@
(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)
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)
(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)))
container (ctn/make-container page :page)]
orig-touched (filter (comp seq :touched) original-shapes)
orig-objects (into {} (map (juxt :id identity) original-shapes))
container (ctn/make-container page :page)]
(reduce
(fn [changes touched-shape]
(let [related-shape (get new-shapes-map (:shape-path touched-shape))
(let [path (generate-path "" orig-objects (:id original-shape) touched-shape)
related-shape (get new-path-map path)
orig-ref-shape (ctf/find-ref-shape nil container libraries touched-shape)]
(if related-shape
(cll/update-attrs-on-switch

View File

@@ -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,28 +48,38 @@
(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"
"font/woff" ".woff"
"font/woff2" ".woff2"
"font/ttf" ".ttf"
"font/otf" ".otf"
"application/octet-stream" ".bin"
"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"
nil))
(defn strip-image-extension
[filename]
(let [image-extensions-re #"(\.png)|(\.jpg)|(\.jpeg)|(\.webp)|(\.gif)|(\.svg)$"]
(str/replace filename image-extensions-re "")))
(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 parse-font-weight
[variant]

View File

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

View File

@@ -7,7 +7,6 @@
(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]))
@@ -91,7 +90,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 " && " children) (-titled s)))
(defmethod visit :and [_ s children _] (str (str/join ", and " 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) ")"))
@@ -107,8 +106,7 @@
(defmethod visit :qualified-symbol [_ _ _ _] "qualified symbol")
(defmethod visit :uuid [_ _ _ _] "uuid")
(defmethod visit :boolean [_ _ _ _] "boolean")
(defmethod visit :keyword [_ _ _ _] "string")
(defmethod visit :fn [_ _ _ _] "FN")
(defmethod visit :keyword [_ _ _ _] "keyword")
(defmethod visit :vector [_ _ children _]
(str "[" (last children) "]"))
@@ -125,10 +123,8 @@
(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 _]
(defmethod visit :set [_ schema children _]
(str "set[" (first children) "]" (minmax-suffix schema)))
(defmethod visit ::m/val [_ schema children _]
@@ -156,6 +152,7 @@
(or (:title props)
"*")))
(defmethod visit :map
[_ schema children {:keys [::level ::max-level] :as options}]
(let [props (m/properties schema)
@@ -175,11 +172,13 @@
": " s)))
(str/join ",\n"))
header (cond-> (str "type " title)
header (cond-> (if (zero? level)
(str "type " title)
(str title))
closed? (str "!")
(some? title) (str " "))]
(str (pad header level) "{\n" entries "\n" (pad "}\n" level))))))
(str header "{\n" entries "\n" (pad "}" level))))))
(defmethod visit :multi
[_ s children {:keys [::level ::max-level] :as options}]
@@ -206,18 +205,18 @@
(defmethod visit :merge
[_ schema children _]
(let [entries (str/join ",\n" children)
(let [entries (str/join " , " children)
props (m/properties schema)
title (or (some-> (:title props) str/camel str/capital)
"<untitled>")]
(str "merge type " title " { \n" entries "\n}\n")))
(str "merge object " title " { " entries " }")))
(defmethod visit ::sm/one-of
[_ _ children _]
(defmethod visit :app.common.schema/one-of
[_ _ children _]
(let [elems (last children)]
(str "string oneOf (" (->> elems
(map d/name)
(str/join "|")) ")")))
(str "OneOf[" (->> elems
(map d/name)
(str/join ",")) "]")))
(defmethod visit :schema [_ schema children options]
(visit ::m/schema schema children options))

View File

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

View File

@@ -97,8 +97,7 @@
(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 (str (first (m/children schema options)))})
(defmethod visit :re [_ schema _ options] {:type "string", :pattern (first (m/children schema options))})
(defmethod visit :nil [_ _ _ _] {:type "null"})
(defmethod visit :string [_ schema _ _]

View File

@@ -6,6 +6,8 @@
(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]
@@ -13,7 +15,15 @@
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
[cuerdas.core :as str])
#?(:clj
(:import
clojure.lang.XMLHandler
java.io.InputStream
javax.xml.XMLConstants
javax.xml.parsers.SAXParserFactory
org.apache.commons.io.IOUtils)))
;; Regex for XML ids per Spec
;; https://www.w3.org/TR/2008/REC-xml-20081126/#sec-common-syn
@@ -1020,3 +1030,24 @@
: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)))))

View File

@@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.files.shapes-builder
(ns app.common.svg.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.types.path :as path]
[app.common.svg.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/from-string (:d attrs))
content (cond-> (path/parse (:d attrs))
(some? transform)
(path.segm/transform-content transform))

View File

@@ -14,9 +14,7 @@
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.shapes :as ths]
[app.common.text :as txt]
[app.common.types.container :as ctn]
[app.common.types.shape :as cts]))
[app.common.types.container :as ctn]))
;; ----- File building
@@ -60,18 +58,6 @@
: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]}]

View File

@@ -35,7 +35,7 @@
(.. r (toString 16) (padStart 2 "0"))
(.. g (toString 16) (padStart 2 "0"))
(.. b (toString 16) (padStart 2 "0"))))))
sg/int))
sg/any))
(defn rgb-color-string?
[o]
@@ -54,13 +54,13 @@
::oapi/type "integer"
::oapi/format "int64"}}))
(def schema:image
(def schema:image-color
[:map {:title "ImageColor"}
[:name {:optional true} :string]
[:width ::sm/int]
[:height ::sm/int]
[:mtype ::sm/text]
[:mtype {:optional true} [:maybe :string]]
[: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]]
[:image {:optional true} [:maybe schema:image-color]]
[: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]]]
[:image {:optional true} [:maybe schema:image-color]]]
[::sm/contains-any {:strict true} [:color :gradient :image]]])
;; Same as color but with :id prop required
@@ -115,10 +115,9 @@
(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)
(sm/register! ::image-color schema:image-color)
(sm/register! ::recent-color schema:recent-color)
(sm/register! ::color-attrs schema:color-attrs)

View File

@@ -18,10 +18,8 @@
[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]
[clojure.set :as set]))
[app.common.uuid :as uuid]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
@@ -536,6 +534,8 @@
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,33 +566,22 @@
(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?
(not-empty groups)
(not ignore?)
(not (and ignore-geometry is-geometry?)))
(or (and group (not equal?)) (seq token-groups))
(not ignore?) (not (and ignore-geometry is-geometry?)))
(-> (update :touched (fn [touched]
(reduce #(ctk/set-touched-group %1 %2)
touched
groups)))
(if group
(cons group token-groups)
token-groups))))
(dissoc :remote-synced))
(nil? val)

View File

@@ -32,31 +32,24 @@
[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 "FileMedia"}
[:map {:title "FileMediaObject"}
[:id ::sm/uuid]
[:created-at {:optional true} ::sm/inst]
[:created-at ::sm/inst]
[:deleted-at {:optional true} ::sm/inst]
[:name :string]
[:width ::sm/safe-int]
[:height ::sm/safe-int]
[:mtype :string]
[:media-id ::sm/uuid]
[:file-id {:optional true} ::sm/uuid]
[:media-id ::sm/uuid]
[:thumbnail-id {:optional true} ::sm/uuid]
[:is-local {:optional true} :boolean]])
[:is-local :boolean]])
(def schema:colors
[:map-of {:gen/max 5} ::sm/uuid ::ctc/color])
@@ -72,8 +65,7 @@
(def schema:options
[:map {:title "FileOptions"}
[:components-v2 {:optional true} ::sm/boolean]
[:base-font-size {:optional true} :string]])
[:components-v2 {:optional true} ::sm/boolean]])
(def schema:data
[:map {:title "FileData"}
@@ -110,6 +102,7 @@
(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"))
@@ -117,7 +110,7 @@
(def check-file-data
(sm/check-fn schema:data))
(def check-file-media
(def check-media-object
(sm/check-fn schema:media))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -141,8 +134,7 @@
(ctpl/add-page page)
:always
(update :options merge {:components-v2 true
:base-font-size BASE-FONT-SIZE})))))
(update :options assoc :components-v2 true)))))
(defn make-file
[{:keys [id project-id name revn is-shared features migrations
@@ -299,6 +291,7 @@
(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
@@ -1036,14 +1029,3 @@
(-> 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))

View File

@@ -22,14 +22,6 @@
#?(: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))
@@ -44,10 +36,6 @@
[data]
(impl/from-bytes data))
(defn from-string
[data]
(impl/from-string data))
(defn check-path-content
[content]
(impl/check-content-like content))
@@ -205,13 +193,6 @@
(-> (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)

View File

@@ -18,13 +18,28 @@
(def default-fills
[{:fill-color clr/black}])
(def group-style-properties
#{:shadow :blur})
(def style-group-properties
[:shadow :blur])
;; FIXME: revisit
(def style-properties
(into group-style-properties
[:fills :strokes]))
(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]))
(defn add-previous
([content]

View File

@@ -54,12 +54,11 @@
result)))
{})))
;; FIXME: can be optimized with internal reduction
(defn point-indices
[content point]
(->> (d/enumerate content)
(filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
(map (fn [[index _]] index))))
(mapv (fn [[index _]] index))))
(defn handler-indices
"Return an index where the key is the positions and the values the handlers"
@@ -183,11 +182,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 precision]
[position start end h1 h2]
(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)) precision)
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
(-> (helpers/curve-values start end h1 h2 t1)
;; store the segment info
(with-meta {:t t1 :from-p start :to-p end}))
@@ -215,7 +214,7 @@
(double t2)))))))
(defn- line-closest-point
"Finds the closest point in the line segment defined by from-p and to-p"
"Point on line"
[position from-p to-p]
(let [e1 (gpt/to-vec from-p to-p)
@@ -236,13 +235,15 @@
from-p
to-p))))
(defn closest-point
"Returns the closest point in the path to the position, at a given precision"
[content position precision]
;; 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)
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])
@@ -253,7 +254,44 @@
(line-closest-point position from-p to-p)
:curve-to
(curve-closest-point position from-p to-p h1 h2 precision)
(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]
(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
@@ -273,51 +311,41 @@
(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.
NOTE: works with plain format so it expects to receive a vector"
beginning and end points. This makes them really line-to commands"
[content]
(assert (vector? content) "expected a plain format for `content`")
(let [with-prev (d/enumerate (d/with-prev content))
process-command
(fn [content [index [command prev]]]
process-segment
(fn [content [index [segment prev]]]
(let [cur-point (helpers/segment->point segment)
(let [cur-point (helpers/segment->point command)
pre-point (helpers/segment->point prev)
handler-c1 (get-handler segment :c1)
handler-c2 (get-handler segment :c2)]
(if (and (= :curve-to (:command segment))
handler-c1 (get-handler command :c1)
handler-c2 (get-handler command :c2)]
(if (and (= :curve-to (:command command))
(= cur-point handler-c2)
(= pre-point handler-c1))
(assoc content index {:command :line-to
:params (into {} cur-point)})
content)))]
(reduce process-segment content with-prev)))
(reduce process-command 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))
transform-content
(let [handlers (-> (get-handlers content)
(get point))
change-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)))))
(assoc-in [index :params cy] (:y point)))))]
(as-> content $
(reduce change-content $ handlers)
(remove-line-curves $))))
content
(reduce transform-content (vec content) handlers)
content
(remove-line-curves content)]
(impl/from-plain content)))
(defn- line->curve
[from-p segment]
@@ -357,118 +385,88 @@
(def ^:private xf:mapcat-points
(comp
(mapcat #(list (:next-p %) (:prev-p %)))
(mapcat #(vector (: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 [;; 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)
(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)
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)
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)
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)
points (into #{} xf:mapcat-points vectors)]
points
(into #{} xf:mapcat-points vectors)
(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)
;; We transform content to a plain format for execute the
;; algorithm because right now is the only way to execute it
content
(vec content)
add-curve
(fn [content {:keys [index prev-p next-p next-i]}]
(let [cur-segment (get content index)
next-segment (get content next-i)
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)
;; 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))
add-curve
(fn [content {:keys [index prev-p next-p next-i]}]
(let [curr-segment (get content index)
curr-command (get curr-segment :command)
;; 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)))
next-segment (get content next-i)
next-command (get next-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)
;; New handlers for prev-point and next-point
prev-h
(when (some? prev-p) (gpt/add prev-p vh))
(and (= :line-to (:command next-segment)) (some? next-p))
(update next-i helpers/update-curve-to next-h next-p)
next-h
(when (some? next-p) (gpt/add next-p vh))
(and (= :curve-to (:command cur-segment)) (some? prev-p))
(update index update-handler :c2 prev-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)))
(and (= :curve-to (:command next-segment)) (some? next-p))
(update next-i update-handler :c1 next-h))))]
next-correction
(when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
(reduce add-curve content vectors))
prev-h
(when (some? prev-h) (gpt/add prev-h prev-correction))
(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 %))
next-h
(when (some? next-h) (gpt/add next-h next-correction))]
(= :curve-to (:command segment))
(update index #(line->curve prev-p %))
(cond-> content
(and (= :line-to curr-command) (some? prev-p))
(update index helpers/update-curve-to prev-p prev-h)
(= :line-to (:command next-c))
(update next-i #(line->curve point %))
(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)))
(= :curve-to (:command next-c))
(update next-i #(line->curve point %))))]
(reduce add-curve content vectors)))))
(defn get-segments-with-points
"Given a content and a set of points return all the segments in the path

View File

@@ -761,8 +761,3 @@
(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)

View File

@@ -16,56 +16,54 @@
(def node-types #{"root" "paragraph-set" "paragraph"})
(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!
^{::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]]]]]]]]]]]]])
(sm/register! ::content schema:content)
(def valid-content?
(sm/lazy-validator schema:content))
(sm/register!
^{::sm/type ::position-data}

View File

@@ -1,144 +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.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)]))))

View File

@@ -7,7 +7,6 @@
(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]
@@ -119,7 +118,7 @@
[:map {:title "Token"}
[:name cto/token-name-ref]
[:type [::sm/one-of cto/token-types]]
[:value ::sm/any]
[:value :any]
[:description {:optional true} :string]
[:modified-at {:optional true} ::sm/inst]])
@@ -390,8 +389,7 @@
[:description {:optional true} :string]
[:modified-at {:optional true} ::sm/inst]
[:tokens {:optional true
:gen/gen (->> (sg/map-of (sg/generator ::sm/text)
(sg/generator schema:token))
:gen/gen (->> (sg/generator [:map-of ::sm/text schema:token])
(sg/fmap #(into (d/ordered-map) %)))}
[:and
[:map-of {:gen/max 5
@@ -662,6 +660,63 @@
(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.
@@ -771,10 +826,51 @@
(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")
@@ -791,11 +887,12 @@ 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.
@@ -812,9 +909,6 @@ 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]
@@ -1189,6 +1283,142 @@ 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]
@@ -1250,13 +1480,17 @@ Will return a value that matches this schema:
[tokens-lib]
(or tokens-lib (make-tokens-lib)))
(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 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}})
(defn duplicate-set [set-name lib & {:keys [suffix]}]
(let [sets (get-sets lib)
@@ -1266,335 +1500,7 @@ Will return a value that matches this schema:
(assoc :name copy-name)
(assoc :modified-at (dt/now)))))
;; === 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))))
(sm/register! type:tokens-lib)
;; === Serialization handlers for RPC API (transit) and database (fressian)

View File

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

View File

@@ -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.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"))))

View File

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

View File

@@ -114,8 +114,11 @@
(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? 0.01 (get-in shape-after [:selrect :width])))
(t/is (close? 0.01 (get-in shape-after [:selrect :height])))))
(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/testing "Transform shape with rotation modifiers"
(t/are [type]

View File

@@ -1,881 +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.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)))))

View File

@@ -1,132 +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.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')))))

View File

@@ -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.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"))))

View File

@@ -9,6 +9,7 @@
[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]
@@ -28,7 +29,6 @@
[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,6 +58,7 @@
(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
@@ -77,7 +78,6 @@
'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.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.shape-decode-encode-test
'common-tests.types.tokens-lib-test
'common-tests.types.components-test
'common-tests.types.absorb-assets-test
'common-tests.types.path-data-test
'common-tests.uuid-test))

View File

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

View File

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

View File

@@ -1,88 +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.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))))

View File

@@ -7,9 +7,8 @@
(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]
@@ -1388,28 +1387,14 @@
(t/is (nil? token-theme'))))
#?(:clj
(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 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
(t/deftest legacy-json-decoding
(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 "")
(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"
@@ -1417,29 +1402,32 @@
(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/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? (ctob/get-token-in-set lib "typography" "H1.Bold")))))))
(t/is (nil? (get-set-token "typography" "H1.Bold")))))))
#?(:clj
(t/deftest parse-multi-set-dtcg-json
(t/deftest dtcg-encoding-decoding-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 "")
(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)))
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"
@@ -1447,29 +1435,32 @@
(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")
(t/is (tht/token-data-eq? (get-set-token "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")
(t/is (tht/token-data-eq? (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 (tht/token-data-eq? (ctob/get-token-in-set lib "theme" "button.primary.background")
(t/is (tht/token-data-eq? (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? (ctob/get-token-in-set lib "typography" "H1.Bold")))))))
(t/is (nil? (get-set-token "typography" "H1.Bold")))))))
#?(:clj
(t/deftest parse-multi-set-dtcg-json-default-team
(t/deftest decode-dtcg-json-default-team
(let [json (-> (slurp "test/common_tests/types/data/tokens-default-team-only.json")
(json/decode {:key-fn identity}))
lib (ctob/parse-decoded-json 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)))
themes (ctob/get-themes lib)
first-theme (first themes)]
(t/is (= '("dark") (ctob/get-ordered-set-names lib)))
@@ -1478,14 +1469,15 @@
(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? (ctob/get-token-in-set lib "dark" "small")
(t/is (tht/token-data-eq? (get-set-token "dark" "small")
{:name "small"
:value "8"
:type :border-radius
:description ""}))))))
#?(:clj
(t/deftest export-dtcg-json
(t/deftest encode-dtcg-json
(let [now (dt/now)
tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "core"
@@ -1510,7 +1502,7 @@
:id "test-id-00"
:modified-at now
:sets #{"core"})))
result (ctob/export-dtcg-json tokens-lib)
result (ctob/encode-dtcg tokens-lib)
expected {"$themes" [{"description" ""
"group" "group-1"
"is-source" false
@@ -1536,7 +1528,7 @@
(t/is (= expected result)))))
#?(:clj
(t/deftest export-parse-dtcg-json
(t/deftest encode-decode-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"
@@ -1557,14 +1549,17 @@
:type :color
:value "{accent.default}"})})))
encoded (ctob/export-dtcg-json tokens-lib)
tokens-lib' (ctob/parse-decoded-json encoded "")]
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)]
(t/testing "library got updated but data is equal"
(t/is (not= tokens-lib' tokens-lib))
(t/is (= @tokens-lib' @tokens-lib)))))))
(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))))))
#?(:clj
(t/deftest export-dtcg-json-with-default-theme
(t/deftest encode-default-theme-json
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "core"
:tokens {"colors.red.600"
@@ -1583,7 +1578,7 @@
{:name "button.primary.background"
:type :color
:value "{accent.default}"})})))
result (ctob/export-dtcg-json tokens-lib)
result (ctob/encode-dtcg tokens-lib)
expected {"$themes" []
"$metadata" {"tokenSetOrder" ["core"]
"activeSets" #{}, "activeThemes" #{}}
@@ -1604,7 +1599,7 @@
(t/is (= expected result)))))
#?(:clj
(t/deftest export-dtcg-json-with-active-theme-and-set
(t/deftest encode-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"
@@ -1630,7 +1625,7 @@
:modified-at now
:sets #{"core"}))
(ctob/toggle-theme-active? "group-1" "theme-1"))
result (ctob/export-dtcg-json tokens-lib)
result (ctob/encode-dtcg tokens-lib)
expected {"$themes" [{"description" ""
"group" "group-1"
"is-source" false

View File

@@ -9,57 +9,32 @@
[app.common.types.variant :as ctv]
[clojure.test :as t]))
(t/deftest convert-between-variant-properties-maps-and-formulas
(t/deftest convert-between-variant-properties-maps-and-strings
(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-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"}]
map-with-spaces [{:name "border 1" :value "of course"} {:name "color 2" :value "dark gray"}]
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, 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"
string-valid-with-spaces "border 1=of course, color 2=dark gray"
string-invalid "border=yes, color="]
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 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)))
(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 "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 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/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/deftest find-properties

4
common/vendor/beicon/impl/rxjs.cljs vendored Normal file
View File

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

View File

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

4
common/vendor/tubax/saxjs.cljs vendored Normal file
View File

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

View File

File diff suppressed because it is too large Load Diff

View File

@@ -19,7 +19,11 @@ 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 \
@@ -28,13 +32,19 @@ 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; \
@@ -43,19 +53,6 @@ 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 \
@@ -100,23 +97,6 @@ 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/*;
@@ -179,6 +159,7 @@ 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; \
@@ -260,10 +241,10 @@ RUN set -ex; \
mv /tmp/mc /usr/local/bin/; \
chmod +x /usr/local/bin/mc;
WORKDIR /usr/local
# Install Rust toolchain
ENV PATH=/usr/local/cargo/bin:$PATH RUSTUP_HOME=/usr/local/rustpo CARGO_HOME=/usr/local/cargo
ENV RUSTUP_HOME=/usr/local/rustup \
CARGO_HOME=/usr/local/cargo \
PATH=/usr/local/cargo/bin:$PATH;
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
@@ -273,20 +254,27 @@ RUN set -eux; \
arm64) rustArch='aarch64-unknown-linux-gnu'; rustupSha256='1cffbf51e63e634c746f741de50649bbbcbd9dbe1de363c9ecef64e278dba2b2' ;; \
*) echo >&2 "unsupported architecture: ${dpkgArch}"; exit 1 ;; \
esac; \
wget "https://static.rust-lang.org/rustup/archive/${RUSTUP_VERSION}/${rustArch}/rustup-init"; \
url="https://static.rust-lang.org/rustup/archive/${RUSTUP_VERSION}/${rustArch}/rustup-init"; \
wget "$url"; \
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; \
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;
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
COPY files/nginx.conf /etc/nginx/nginx.conf
COPY files/nginx-mime.types /etc/nginx/mime.types

View File

@@ -1,20 +0,0 @@
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

View File

@@ -1,5 +1,10 @@
#!/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'

View File

@@ -1,19 +1,6 @@
#!/usr/bin/env bash
set -e
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"
usermod -u ${EXTERNAL_UID:-1000} penpot
exec "$@"

View File

@@ -1,5 +1,10 @@
#!/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

View File

@@ -138,10 +138,6 @@ 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";

Some files were not shown because too many files have changed in this diff Show More