mirror of
https://github.com/penpot/penpot.git
synced 2026-01-06 21:39:00 -05:00
Compare commits
1 Commits
rm
...
hiru-refac
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
41a46fe56a |
@@ -32,42 +32,42 @@ jobs:
|
||||
- run: clj-kondo --version
|
||||
|
||||
- run:
|
||||
name: "backend fmt check"
|
||||
name: "fmt check backend [clj]"
|
||||
working_directory: "./backend"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run fmt:clj:check
|
||||
|
||||
- run:
|
||||
name: "exporter fmt check"
|
||||
name: "fmt check exporter [clj]"
|
||||
working_directory: "./exporter"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run fmt:clj:check
|
||||
|
||||
- run:
|
||||
name: "common fmt check"
|
||||
name: "fmt check common [clj]"
|
||||
working_directory: "./common"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run fmt:clj:check
|
||||
|
||||
- run:
|
||||
name: "frontend fmt check"
|
||||
name: "fmt check frontend [clj]"
|
||||
working_directory: "./frontend"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run fmt:clj:check
|
||||
|
||||
- run:
|
||||
name: "common linter check"
|
||||
name: common lint
|
||||
working_directory: "./common"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run lint:clj
|
||||
|
||||
- run:
|
||||
name: "frontend linter check"
|
||||
name: frontend lint
|
||||
working_directory: "./frontend"
|
||||
command: |
|
||||
yarn install
|
||||
@@ -75,14 +75,14 @@ jobs:
|
||||
yarn run lint:clj
|
||||
|
||||
- run:
|
||||
name: "backend linter check"
|
||||
name: backend lint
|
||||
working_directory: "./backend"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run lint:clj
|
||||
|
||||
- run:
|
||||
name: "exporter linter check"
|
||||
name: exporter lint
|
||||
working_directory: "./exporter"
|
||||
command: |
|
||||
yarn install
|
||||
@@ -93,7 +93,7 @@ jobs:
|
||||
working_directory: "./common"
|
||||
command: |
|
||||
yarn test
|
||||
clojure -M:dev:test
|
||||
clojure -X:dev:test :patterns '["common-tests.*-test"]'
|
||||
|
||||
- run:
|
||||
name: "frontend tests"
|
||||
@@ -102,21 +102,11 @@ jobs:
|
||||
yarn install
|
||||
yarn test
|
||||
|
||||
- run:
|
||||
name: "frontend integration tests"
|
||||
working_directory: "./frontend"
|
||||
command: |
|
||||
yarn install
|
||||
yarn run compile
|
||||
clojure -M:dev:shadow-cljs release main
|
||||
yarn playwright install --with-deps chromium
|
||||
yarn e2e:test
|
||||
|
||||
- run:
|
||||
name: "backend tests"
|
||||
working_directory: "./backend"
|
||||
command: |
|
||||
clojure -M:dev:test
|
||||
clojure -X:dev:test :patterns '["backend-tests.*-test"]'
|
||||
|
||||
environment:
|
||||
PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
|
||||
|
||||
@@ -12,7 +12,6 @@
|
||||
|
||||
(def registry (atom {}))
|
||||
|
||||
|
||||
(defn potok-reify
|
||||
[{:keys [:node :filename] :as params}]
|
||||
(let [[rnode rtype & other] (:children node)
|
||||
|
||||
5
.gitignore
vendored
5
.gitignore
vendored
@@ -57,7 +57,6 @@
|
||||
/frontend/package-lock.json
|
||||
/frontend/resources/fonts/experiments
|
||||
/frontend/resources/public/*
|
||||
/frontend/storybook-static/
|
||||
/frontend/target/
|
||||
/other/
|
||||
/scripts/
|
||||
@@ -69,7 +68,3 @@
|
||||
clj-profiler/
|
||||
node_modules
|
||||
frontend/.storybook/preview-body.html
|
||||
/test-results/
|
||||
/playwright-report/
|
||||
/blob-report/
|
||||
/playwright/.cache/
|
||||
|
||||
74
CHANGES.md
74
CHANGES.md
@@ -1,67 +1,5 @@
|
||||
# CHANGELOG
|
||||
|
||||
## 2.1.0
|
||||
|
||||
### :rocket: Epics and highlights
|
||||
|
||||
### :boom: Breaking changes & Deprecations
|
||||
|
||||
### :heart: Community contributions (Thank you!)
|
||||
|
||||
### :sparkles: New features
|
||||
|
||||
- Improve auth process [Taiga #7094](https://tree.taiga.io/project/penpot/us/7094)
|
||||
- Add locking degrees increment (hold shift) on path edition [Taiga #7761](https://tree.taiga.io/project/penpot/issue/7761)
|
||||
- Persistence & Concurrent Edition Enhancements [Taiga #5657](https://tree.taiga.io/project/penpot/us/5657)
|
||||
- Allow library colors as recent colors [Taiga #7640](https://tree.taiga.io/project/penpot/issue/7640)
|
||||
- Missing scroll in viewmode comments [Taiga #7427](https://tree.taiga.io/project/penpot/issue/7427)
|
||||
- Comments in View mode should mimic the positioning behavior of the Workspace [Taiga #7346](https://tree.taiga.io/project/penpot/issue/7346)
|
||||
- Misaligned input on comments [Taiga #7461](https://tree.taiga.io/project/penpot/issue/7461)
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
- Fix selection rectangle appears on scroll [Taiga #7525](https://tree.taiga.io/project/penpot/issue/7525)
|
||||
- Fix layer tree not expanding to the bottom edge [Taiga #7466](https://tree.taiga.io/project/penpot/issue/7466)
|
||||
- Fix guides move when board is moved by inputs [Taiga #8010](https://tree.taiga.io/project/penpot/issue/8010)
|
||||
- Fix clickable area of Penptot logo in the viewer [Taiga #7988](https://tree.taiga.io/project/penpot/issue/7988)
|
||||
- Fix constraints dropdown when selecting multiple shapes [Taiga #7686](https://tree.taiga.io/project/penpot/issue/7686)
|
||||
- Layout and scrollign fixes for the bottom palette [Taiga #7559](https://tree.taiga.io/project/penpot/issue/7559)
|
||||
- Fix expand libraries when search results are present [Taiga #7876](https://tree.taiga.io/project/penpot/issue/7876)
|
||||
- Fix color palette default library [Taiga #8029](https://tree.taiga.io/project/penpot/issue/8029)
|
||||
- Component Library is lost after exporting/importing in .zip format [Github #4672](https://github.com/penpot/penpot/issues/4672)
|
||||
- Fix problem with moving+selection not working properly [Taiga #7943](https://tree.taiga.io/project/penpot/issue/7943)
|
||||
- Fix problem with flex layout fit to content not positioning correctly children [Taiga #7537](https://tree.taiga.io/project/penpot/issue/7537)
|
||||
- Fix black line is displaying after show main [Taiga #7653](https://tree.taiga.io/project/penpot/issue/7653)
|
||||
- Fix "Share prototypes" modal remains open [Taiga #7442](https://tree.taiga.io/project/penpot/issue/7442)
|
||||
- Fix "Components visibility and opacity" [#4694](https://github.com/penpot/penpot/issues/4694)
|
||||
- Fix "Attribute overrides in copies are not exported in zip file" [Taiga #8072](https://tree.taiga.io/project/penpot/issue/8072)
|
||||
- Fix group not automatically selected in the Layers panel after creation [Taiga #8078](https://tree.taiga.io/project/penpot/issue/8078)
|
||||
- Fix export boards loses opacity [Taiga #7592](https://tree.taiga.io/project/penpot/issue/7592)
|
||||
- Fix change color on imported svg also changes the stroke alignment[Taiga #7673](https://github.com/penpot/penpot/pull/7673)
|
||||
- Fix show in view mode and interactions workflow [Taiga #4711](https://github.com/penpot/penpot/pull/4711)
|
||||
- Fix internal error when I set up a stroke for some objects without and with stroke [Taiga #7558](https://tree.taiga.io/project/penpot/issue/7558)
|
||||
- Toolbar keeps toggling on and off on spacebar press [Taiga #7654](https://github.com/penpot/penpot/pull/7654)
|
||||
- Fix toolbar keeps hiding when click outside workspace [Taiga #7776](https://tree.taiga.io/project/penpot/issue/7776)
|
||||
- Fix open overlay relative to a frame [Taiga #7563](https://tree.taiga.io/project/penpot/issue/7563)
|
||||
- Workspace-palette items stay hidden when opening with keyboard-shortcut [Taiga #7489](https://tree.taiga.io/project/penpot/issue/7489)
|
||||
- Fix SVG attrs are not handled correctly when exporting/importing in .zip [Taiga #7920](https://tree.taiga.io/project/penpot/issue/7920)
|
||||
- Fix validation error when detaching with two nested copies and a swap [Taiga #8095](https://tree.taiga.io/project/penpot/issue/8095)
|
||||
- Export shapes that are rotated act a bit strange when reimported [Taiga #7585](https://tree.taiga.io/project/penpot/issue/7585)
|
||||
- Penpot crashes when a new colorpicker is created while uploading an image to another instance [Taiga #8119](https://tree.taiga.io/project/penpot/issue/8119)
|
||||
- Removing Underline and Strikethrough Affects the Previous Text Object [Taiga #8103](https://tree.taiga.io/project/penpot/issue/8103)
|
||||
- Color library loses association with shapes when exporting/importing the document [Taiga #8132](https://tree.taiga.io/project/penpot/issue/8132)
|
||||
- Fix can't collapse groups when searching in the assets tab [Taiga #8125](https://tree.taiga.io/project/penpot/issue/8125)
|
||||
- Fix 'Detach instance' shortcut is not working [Taiga #8102](https://tree.taiga.io/project/penpot/issue/8102)
|
||||
- Fix import file message does not detect 0 as error [Taiga #6824](https://tree.taiga.io/project/penpot/issue/6824)
|
||||
- Image Color Library is not persisted when exporting/importing in .zip [Taiga #8131](https://tree.taiga.io/project/penpot/issue/8131)
|
||||
|
||||
## 2.0.3
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
- Fix chrome scrollbar styling [Taiga #7852](https://tree.taiga.io/project/penpot/issue/7852)
|
||||
- Fix incorrect password encoding on create-profile manage scritp [Github #3651](https://github.com/penpot/penpot/issues/3651)
|
||||
|
||||
## 2.0.2
|
||||
|
||||
### :sparkles: Enhancements
|
||||
@@ -69,11 +7,6 @@
|
||||
- Fix locking contention on cron subsystem (causes backend start blocking)
|
||||
- Fix locking contention on file object thumbails backend RPC calls
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
- Fix color palette sorting [Taiga #7458](https://tree.taiga.io/project/penpot/issue/7458)
|
||||
- Fix style scoping problem with imported SVG [Taiga #7671](https://tree.taiga.io/project/penpot/issue/7671)
|
||||
|
||||
|
||||
## 2.0.1
|
||||
|
||||
@@ -81,7 +14,6 @@
|
||||
|
||||
- Fix different issues related to components v2 migrations including [Github #4443](https://github.com/penpot/penpot/issues/4443)
|
||||
|
||||
|
||||
## 2.0.0 - I Just Can't Get Enough
|
||||
|
||||
### :rocket: Epics and highlights
|
||||
@@ -96,8 +28,6 @@
|
||||
### :boom: Breaking changes & Deprecations
|
||||
|
||||
- New strokes default to inside border [Taiga #6847](https://tree.taiga.io/project/penpot/issue/6847)
|
||||
- Change default z ordering on layers in flex layout. The previous behavior was inconsistent with how HTML works and we changed it to be more consistent. Previous layers that overlapped could be hidden, the fastest way to fix this is changing the z-index property but a better way is to change the order of your layers.
|
||||
|
||||
|
||||
### :heart: Community contributions (Thank you!)
|
||||
- New Hausa, Yoruba and Igbo translations and update translation files (by All For Tech Empowerment Foundation) [Taiga #6950](https://tree.taiga.io/project/penpot/us/6950), [Taiga #6534](https://tree.taiga.io/project/penpot/us/6534)
|
||||
@@ -175,7 +105,7 @@
|
||||
- [REDESIGN] Panels visual separations [Taiga #6692](https://tree.taiga.io/project/penpot/us/6692)
|
||||
- [REDESIGN] Onboarding slides [Taiga #6678](https://tree.taiga.io/project/penpot/us/6678)
|
||||
|
||||
### :bug: Bugs fixed
|
||||
### :bug Bugs fixed
|
||||
- Fix pixelated thumbnails [Github #3681](https://github.com/penpot/penpot/issues/3681), [Github #3661](https://github.com/penpot/penpot/issues/3661)
|
||||
- Fix problem with not applying colors to boards [Github #3941](https://github.com/penpot/penpot/issues/3941)
|
||||
- Fix problem with path editor undoing changes [Github #3998](https://github.com/penpot/penpot/issues/3998)
|
||||
@@ -216,7 +146,7 @@
|
||||
- Fix problem when changing typography assets [Github #3683](https://github.com/penpot/penpot/issues/3683)
|
||||
- Internal error when you copy and paste some main components between files [Taiga #7397](https://tree.taiga.io/project/penpot/issue/7397)
|
||||
- Fix toolbar disappearing [Taiga #7411](https://tree.taiga.io/project/penpot/issue/7411)
|
||||
- Fix long text on tab breaks UI [Taiga #7421](https://tree.taiga.io/project/penpot/issue/7421)
|
||||
- Fix long text on tab breaks UI [Taiga Issue #7421](https://tree.taiga.io/project/penpot/issue/7421)
|
||||
|
||||
## 1.19.5
|
||||
|
||||
|
||||
@@ -43,7 +43,8 @@ Penpot is available on browser and [self host](https://penpot.app/self-host). It
|
||||
Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the platform to a whole new level. This update introduces the ground-breaking [CSS Grid Layout feature](https://penpot.app/penpot-2.0), a complete UI redesign, a new Components system, and much more. Plus, it's faster and more accessible.
|
||||
|
||||
|
||||
🎇 **Penpot Fest** is our design, code & Open Source event. Check out the highlights from [Penpot Fest 2023 edition](https://www.youtube.com/watch?v=sOpLZaK5mDc)!
|
||||
🎇 **Penpot Fest is back!** Our design, code & Open Source event is happening in Barcelona | June 5-7th. [Get your tickets](https://www.eventbrite.es/e/penpot-fest-2024-tickets-859331883797) to join other designers and developers from open-source communities and beyond.
|
||||
Check out the highlights from [Penpot Fest 2023 edition](https://www.youtube.com/watch?v=sOpLZaK5mDc)!
|
||||
|
||||
## Table of contents ##
|
||||
|
||||
|
||||
@@ -2,19 +2,12 @@
|
||||
|
||||
We want to thank to the amazing people that help us! Thank you! You're the best!
|
||||
|
||||
Feel free you make a PR updating this file if you miss you in the
|
||||
list.
|
||||
|
||||
## Security
|
||||
|
||||
* Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
|
||||
* [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
|
||||
* Vaibhav Shukla
|
||||
* Hassan Ahmed (Alias Xen Lee)
|
||||
* Michal Biesiada (@mbiesiad)
|
||||
|
||||
## Internationalization
|
||||
|
||||
* [00ff88](https://hosted.weblate.org/user/00ff88)
|
||||
* [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
|
||||
* [Aimee](https://hosted.weblate.org/user/Aimee)
|
||||
@@ -96,7 +89,6 @@ list.
|
||||
* [zcraber](https://hosted.weblate.org/user/zcraber)
|
||||
|
||||
## Libraries & templates
|
||||
|
||||
* systxema
|
||||
* plumilla
|
||||
* victor crespo
|
||||
|
||||
@@ -3,10 +3,10 @@
|
||||
|
||||
:deps
|
||||
{penpot/common {:local/root "../common"}
|
||||
org.clojure/clojure {:mvn/version "1.12.0-alpha12"}
|
||||
org.clojure/clojure {:mvn/version "1.12.0-alpha9"}
|
||||
org.clojure/tools.namespace {:mvn/version "1.5.0"}
|
||||
|
||||
com.github.luben/zstd-jni {:mvn/version "1.5.6-3"}
|
||||
com.github.luben/zstd-jni {:mvn/version "1.5.5-11"}
|
||||
|
||||
io.prometheus/simpleclient {:mvn/version "0.16.0"}
|
||||
io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
|
||||
@@ -26,13 +26,13 @@
|
||||
:git/url "https://github.com/funcool/yetti.git"
|
||||
:exclusions [org.slf4j/slf4j-api]}
|
||||
|
||||
com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
|
||||
metosin/reitit-core {:mvn/version "0.7.0"}
|
||||
nrepl/nrepl {:mvn/version "1.1.2"}
|
||||
cider/cider-nrepl {:mvn/version "0.48.0"}
|
||||
com.github.seancorfield/next.jdbc {:mvn/version "1.3.925"}
|
||||
metosin/reitit-core {:mvn/version "0.6.0"}
|
||||
nrepl/nrepl {:mvn/version "1.1.1"}
|
||||
cider/cider-nrepl {:mvn/version "0.47.1"}
|
||||
|
||||
org.postgresql/postgresql {:mvn/version "42.7.3"}
|
||||
org.xerial/sqlite-jdbc {:mvn/version "3.46.0.0"}
|
||||
org.xerial/sqlite-jdbc {:mvn/version "3.45.2.0"}
|
||||
|
||||
com.zaxxer/HikariCP {:mvn/version "5.1.0"}
|
||||
|
||||
@@ -58,7 +58,7 @@
|
||||
|
||||
;; Pretty Print specs
|
||||
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
|
||||
software.amazon.awssdk/s3 {:mvn/version "2.25.63"}
|
||||
software.amazon.awssdk/s3 {:mvn/version "2.22.12"}
|
||||
}
|
||||
|
||||
:paths ["src" "resources" "target/classes"]
|
||||
@@ -74,13 +74,16 @@
|
||||
|
||||
:build
|
||||
{:extra-deps
|
||||
{io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
|
||||
{io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
|
||||
:ns-default build}
|
||||
|
||||
:test
|
||||
{:main-opts ["-m" "kaocha.runner"]
|
||||
:jvm-opts ["-Dlog4j2.configurationFile=log4j2-devenv-repl.xml"]
|
||||
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
|
||||
{:extra-paths ["test"]
|
||||
:extra-deps
|
||||
{io.github.cognitect-labs/test-runner
|
||||
{:git/tag "v0.5.1" :git/sha "dfb30dd"}}
|
||||
:main-opts ["-m" "cognitect.test-runner"]
|
||||
:exec-fn cognitect.test-runner.api/test}
|
||||
|
||||
:outdated
|
||||
{:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
|
||||
|
||||
@@ -4,19 +4,19 @@
|
||||
"license": "MPL-2.0",
|
||||
"author": "Kaleidos INC",
|
||||
"private": true,
|
||||
"packageManager": "yarn@4.2.2",
|
||||
"packageManager": "yarn@4.0.2",
|
||||
"repository": {
|
||||
"type": "git",
|
||||
"url": "https://github.com/penpot/penpot"
|
||||
},
|
||||
"dependencies": {
|
||||
"luxon": "^3.4.4",
|
||||
"sax": "^1.4.1"
|
||||
"luxon": "^3.4.2",
|
||||
"sax": "^1.2.4"
|
||||
},
|
||||
"devDependencies": {
|
||||
"nodemon": "^3.1.2",
|
||||
"nodemon": "^3.0.1",
|
||||
"source-map-support": "^0.5.21",
|
||||
"ws": "^8.17.0"
|
||||
"ws": "^8.13.0"
|
||||
},
|
||||
"scripts": {
|
||||
"fmt:clj:check": "cljfmt check --parallel=false src/ test/",
|
||||
|
||||
@@ -168,7 +168,7 @@
|
||||
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
|
||||
<tr>
|
||||
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
@@ -475,4 +475,4 @@
|
||||
</div>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
</html>
|
||||
@@ -1,4 +1,4 @@
|
||||
Hello {{name|abbreviate:25}}!
|
||||
Hello {{name}}!
|
||||
|
||||
We received a request to change your current email to {{ pending-email }}.
|
||||
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
{% if profile %}
|
||||
<span>
|
||||
<span>Name: </span>
|
||||
<span><code>{{profile.fullname|abbreviate:25}}</code></span>
|
||||
<span><code>{{profile.fullname}}</code></span>
|
||||
</span>
|
||||
<br />
|
||||
|
||||
@@ -34,7 +34,7 @@
|
||||
</p>
|
||||
<p>
|
||||
<strong>Subject:</strong><br />
|
||||
<span>{{subject|abbreviate:300}}</span>
|
||||
<span>{{subject}}</span>
|
||||
</p>
|
||||
|
||||
<p>
|
||||
|
||||
@@ -173,7 +173,7 @@
|
||||
</tr>
|
||||
<tr>
|
||||
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.</div>
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">{{invited-by}} has invited you to join the team “{{ team }}”.</div>
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
@@ -465,4 +465,4 @@
|
||||
</div>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
</html>
|
||||
@@ -1,6 +1,6 @@
|
||||
Hello!
|
||||
|
||||
{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.
|
||||
{{invited-by}} has invited you to join the team “{{ team }}”.
|
||||
|
||||
Accept invitation using this link:
|
||||
|
||||
|
||||
@@ -168,7 +168,7 @@
|
||||
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
|
||||
<tr>
|
||||
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
@@ -470,4 +470,4 @@
|
||||
</div>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
</html>
|
||||
@@ -1,4 +1,4 @@
|
||||
Hello {{name|abbreviate:25}}!
|
||||
Hello {{name}}!
|
||||
|
||||
We received a request to reset your password. Click the link below to choose a
|
||||
new one:
|
||||
|
||||
@@ -168,7 +168,7 @@
|
||||
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
|
||||
<tr>
|
||||
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
|
||||
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Hello {{name|abbreviate:25}}!
|
||||
Hello {{name}}!
|
||||
|
||||
Thanks for signing up for your Penpot account! Please verify your email using the
|
||||
link below and get started building mockups and prototypes today!
|
||||
|
||||
@@ -6,7 +6,9 @@
|
||||
|
||||
(ns app.auth
|
||||
(:require
|
||||
[buddy.hashers :as hashers]))
|
||||
[app.config :as cf]
|
||||
[buddy.hashers :as hashers]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def default-params
|
||||
{:alg :argon2id
|
||||
@@ -25,3 +27,17 @@
|
||||
(catch Throwable _
|
||||
{:update false
|
||||
:valid false})))
|
||||
|
||||
(defn email-domain-in-whitelist?
|
||||
"Returns true if email's domain is in the given whitelist or if
|
||||
given whitelist is an empty string."
|
||||
([email]
|
||||
(let [domains (cf/get :registration-domain-whitelist)]
|
||||
(email-domain-in-whitelist? domains email)))
|
||||
([domains email]
|
||||
(if (or (nil? domains) (empty? domains))
|
||||
true
|
||||
(let [[_ candidate] (-> (str/lower email)
|
||||
(str/split #"@" 2))]
|
||||
(contains? domains candidate)))))
|
||||
|
||||
|
||||
@@ -7,6 +7,7 @@
|
||||
(ns app.auth.oidc
|
||||
"OIDC client implementation."
|
||||
(:require
|
||||
[app.auth :as auth]
|
||||
[app.auth.oidc.providers :as-alias providers]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
@@ -16,8 +17,6 @@
|
||||
[app.common.uri :as u]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.email.blacklist :as email.blacklist]
|
||||
[app.email.whitelist :as email.whitelist]
|
||||
[app.http.client :as http]
|
||||
[app.http.session :as session]
|
||||
[app.loggers.audit :as audit]
|
||||
@@ -32,7 +31,6 @@
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[integrant.core :as ig]
|
||||
[ring.request :as rreq]
|
||||
[ring.response :as-alias rres]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -471,9 +469,6 @@
|
||||
(some? (:invitation-token state))
|
||||
(assoc :invitation-token (:invitation-token state))
|
||||
|
||||
(some? (:external-session-id state))
|
||||
(assoc :external-session-id (:external-session-id state))
|
||||
|
||||
;; If state token comes with props, merge them. The state token
|
||||
;; props can contain pm_ and utm_ prefixed query params.
|
||||
(map? (:props state))
|
||||
@@ -502,13 +497,12 @@
|
||||
(redirect-response uri))))
|
||||
|
||||
(defn- redirect-to-register
|
||||
[cfg info request]
|
||||
[cfg info]
|
||||
(let [info (assoc info
|
||||
:iss :prepared-register
|
||||
:exp (dt/in-future {:hours 48}))
|
||||
|
||||
params {:token (tokens/generate (::setup/props cfg) info)
|
||||
:provider (:provider (:path-params request))
|
||||
:fullname (:fullname info)}
|
||||
params (d/without-nils params)]
|
||||
|
||||
@@ -555,51 +549,41 @@
|
||||
|
||||
(not (:is-active profile))
|
||||
(let [info (assoc info :profile-id (:id profile))]
|
||||
(redirect-to-register cfg info request))
|
||||
(redirect-to-register cfg info))
|
||||
|
||||
:else
|
||||
(let [sxf (session/create-fn cfg (:id profile))
|
||||
token (or (:invitation-token info)
|
||||
(tokens/generate (::setup/props cfg)
|
||||
{:iss :auth
|
||||
:exp (dt/in-future "15m")
|
||||
:props (:props info)
|
||||
:profile-id (:id profile)}))
|
||||
props (audit/profile->props profile)
|
||||
context (d/without-nils {:external-session-id (:external-session-id info)})]
|
||||
(let [sxf (session/create-fn cfg (:id profile))
|
||||
token (or (:invitation-token info)
|
||||
(tokens/generate (::setup/props cfg)
|
||||
{:iss :auth
|
||||
:exp (dt/in-future "15m")
|
||||
:props (:props info)
|
||||
:profile-id (:id profile)}))]
|
||||
|
||||
(audit/submit! cfg {::audit/type "command"
|
||||
::audit/name "login-with-oidc"
|
||||
::audit/profile-id (:id profile)
|
||||
::audit/ip-addr (audit/parse-client-ip request)
|
||||
::audit/props props
|
||||
::audit/context context})
|
||||
::audit/props (audit/profile->props profile)})
|
||||
|
||||
(->> (redirect-to-verify-token token)
|
||||
(sxf request))))
|
||||
|
||||
(and (email.blacklist/enabled? cfg)
|
||||
(email.blacklist/contains? cfg (:email info)))
|
||||
(redirect-with-error "email-domain-not-allowed")
|
||||
|
||||
(and (email.whitelist/enabled? cfg)
|
||||
(not (email.whitelist/contains? cfg (:email info))))
|
||||
(not (auth/email-domain-in-whitelist? (:email info)))
|
||||
(redirect-with-error "email-domain-not-allowed")
|
||||
|
||||
:else
|
||||
(let [info (assoc info :is-active (provider-has-email-verified? cfg info))]
|
||||
(if (contains? cf/flags :registration)
|
||||
(redirect-to-register cfg info request)
|
||||
(redirect-to-register cfg info)
|
||||
(redirect-with-error "registration-disabled")))))
|
||||
|
||||
(defn- auth-handler
|
||||
[cfg {:keys [params] :as request}]
|
||||
(let [props (audit/extract-utm-params params)
|
||||
esid (rreq/get-header request "x-external-session-id")
|
||||
state (tokens/generate (::setup/props cfg)
|
||||
{:iss :oauth
|
||||
:invitation-token (:invitation-token params)
|
||||
:external-session-id esid
|
||||
:props props
|
||||
:exp (dt/in-future "4h")})
|
||||
uri (build-auth-uri cfg state)]
|
||||
|
||||
@@ -87,10 +87,7 @@
|
||||
:ldap-attrs-fullname "cn"
|
||||
|
||||
;; a server prop key where initial project is stored.
|
||||
:initial-project-skey "initial-project"
|
||||
|
||||
;; time to avoid email sending after profile modification
|
||||
:email-verify-threshold "15m"})
|
||||
:initial-project-skey "initial-project"})
|
||||
|
||||
(s/def ::default-rpc-rlimit ::us/vector-of-strings)
|
||||
(s/def ::rpc-rlimit-config ::fs/path)
|
||||
@@ -104,9 +101,6 @@
|
||||
(s/def ::audit-log-archive-uri ::us/string)
|
||||
(s/def ::audit-log-http-handler-concurrency ::us/integer)
|
||||
|
||||
(s/def ::email-domain-blacklist ::fs/path)
|
||||
(s/def ::email-domain-whitelist ::fs/path)
|
||||
|
||||
(s/def ::deletion-delay ::dt/duration)
|
||||
|
||||
(s/def ::admins ::us/set-of-valid-emails)
|
||||
@@ -119,7 +113,8 @@
|
||||
(s/def ::worker-default-parallelism ::us/integer)
|
||||
(s/def ::worker-webhook-parallelism ::us/integer)
|
||||
|
||||
(s/def ::auth-data-cookie-domain ::us/string)
|
||||
(s/def ::authenticated-cookie-domain ::us/string)
|
||||
(s/def ::authenticated-cookie-name ::us/string)
|
||||
(s/def ::auth-token-cookie-name ::us/string)
|
||||
(s/def ::auth-token-cookie-max-age ::dt/duration)
|
||||
|
||||
@@ -216,7 +211,6 @@
|
||||
(s/def ::telemetry-uri ::us/string)
|
||||
(s/def ::telemetry-with-taiga ::us/boolean)
|
||||
(s/def ::tenant ::us/string)
|
||||
(s/def ::email-verify-threshold ::dt/duration)
|
||||
|
||||
(s/def ::config
|
||||
(s/keys :opt-un [::secret-key
|
||||
@@ -228,6 +222,7 @@
|
||||
::audit-log-http-handler-concurrency
|
||||
::auth-token-cookie-name
|
||||
::auth-token-cookie-max-age
|
||||
::authenticated-cookie-name
|
||||
::authenticated-cookie-domain
|
||||
::database-password
|
||||
::database-uri
|
||||
@@ -237,8 +232,6 @@
|
||||
::database-max-pool-size
|
||||
::default-blob-version
|
||||
::default-rpc-rlimit
|
||||
::email-domain-blacklist
|
||||
::email-domain-whitelist
|
||||
::error-report-webhook
|
||||
::default-executor-parallelism
|
||||
::scheduled-executor-parallelism
|
||||
@@ -338,8 +331,7 @@
|
||||
::telemetry-uri
|
||||
::telemetry-referer
|
||||
::telemetry-with-taiga
|
||||
::tenant
|
||||
::email-verify-threshold]))
|
||||
::tenant]))
|
||||
|
||||
(def default-flags
|
||||
[:enable-backend-api-doc
|
||||
|
||||
@@ -262,12 +262,13 @@
|
||||
(let [email (if factory
|
||||
(factory context)
|
||||
(dissoc context ::conn))]
|
||||
(wrk/submit! {::wrk/task :sendmail
|
||||
::wrk/delay 0
|
||||
::wrk/max-retries 4
|
||||
::wrk/priority 200
|
||||
::db/conn conn
|
||||
::wrk/params email})))
|
||||
(wrk/submit! (merge
|
||||
{::wrk/task :sendmail
|
||||
::wrk/delay 0
|
||||
::wrk/max-retries 4
|
||||
::wrk/priority 200
|
||||
::wrk/conn conn}
|
||||
email))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SENDMAIL FN / TASK HANDLER
|
||||
|
||||
@@ -1,47 +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.email.blacklist
|
||||
"Email blacklist provider"
|
||||
(:refer-clojure :exclude [contains?])
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.config :as cf]
|
||||
[app.email :as-alias email]
|
||||
[clojure.core :as c]
|
||||
[clojure.java.io :as io]
|
||||
[cuerdas.core :as str]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(defmethod ig/init-key ::email/blacklist
|
||||
[_ _]
|
||||
(when (c/contains? cf/flags :email-blacklist)
|
||||
(try
|
||||
(let [path (cf/get :email-domain-blacklist)
|
||||
result (with-open [reader (io/reader path)]
|
||||
(reduce (fn [result line]
|
||||
(if (str/starts-with? line "#")
|
||||
result
|
||||
(conj result (-> line str/trim str/lower))))
|
||||
#{}
|
||||
(line-seq reader)))]
|
||||
(l/inf :hint "initializing email blacklist" :domains (count result))
|
||||
(not-empty result))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "unexpected exception on initializing email blacklist"
|
||||
:cause cause)))))
|
||||
|
||||
(defn contains?
|
||||
"Check if email is in the blacklist."
|
||||
[{:keys [::email/blacklist]} email]
|
||||
(let [[_ domain] (str/split email "@" 2)]
|
||||
(c/contains? blacklist (str/lower domain))))
|
||||
|
||||
(defn enabled?
|
||||
"Check if the blacklist is enabled"
|
||||
[{:keys [::email/blacklist]}]
|
||||
(some? blacklist))
|
||||
@@ -1,59 +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.email.whitelist
|
||||
"Email whitelist provider"
|
||||
(:refer-clojure :exclude [contains?])
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.config :as cf]
|
||||
[app.email :as-alias email]
|
||||
[clojure.core :as c]
|
||||
[clojure.java.io :as io]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.fs :as fs]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(defn- read-whitelist
|
||||
[path]
|
||||
(when (and path (fs/exists? path))
|
||||
(try
|
||||
(with-open [reader (io/reader path)]
|
||||
(reduce (fn [result line]
|
||||
(if (str/starts-with? line "#")
|
||||
result
|
||||
(conj result (-> line str/trim str/lower))))
|
||||
#{}
|
||||
(line-seq reader)))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "unexpected exception on reading email whitelist"
|
||||
:cause cause)))))
|
||||
|
||||
(defmethod ig/init-key ::email/whitelist
|
||||
[_ _]
|
||||
(let [whitelist (or (cf/get :registration-domain-whitelist) #{})
|
||||
whitelist (if (c/contains? cf/flags :email-whitelist)
|
||||
(into whitelist (read-whitelist (cf/get :email-domain-whitelist)))
|
||||
whitelist)
|
||||
whitelist (not-empty whitelist)]
|
||||
|
||||
|
||||
(when whitelist
|
||||
(l/inf :hint "initializing email whitelist" :domains (count whitelist)))
|
||||
|
||||
whitelist))
|
||||
|
||||
(defn contains?
|
||||
"Check if email is in the whitelist."
|
||||
[{:keys [::email/whitelist]} email]
|
||||
(let [[_ domain] (str/split email "@" 2)]
|
||||
(c/contains? whitelist (str/lower domain))))
|
||||
|
||||
(defn enabled?
|
||||
"Check if the whitelist is enabled"
|
||||
[{:keys [::email/whitelist]}]
|
||||
(some? whitelist))
|
||||
@@ -12,6 +12,7 @@
|
||||
[app.common.files.changes :as cp]
|
||||
[app.common.files.changes-builder :as fcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.libraries-helpers :as cflh]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.files.shapes-helpers :as cfsh]
|
||||
[app.common.files.validate :as cfv]
|
||||
@@ -22,7 +23,6 @@
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[app.common.logging :as l]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.math :as mth]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.svg :as csvg]
|
||||
@@ -1450,15 +1450,16 @@
|
||||
page
|
||||
(cons shape children))
|
||||
|
||||
[_ _ changes]
|
||||
(cll/generate-add-component changes
|
||||
[shape]
|
||||
(:objects page)
|
||||
(:id page)
|
||||
file-id
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)]
|
||||
[_ _ changes2]
|
||||
(cflh/generate-add-component nil
|
||||
[shape]
|
||||
(:objects page)
|
||||
(:id page)
|
||||
file-id
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)
|
||||
changes (fcb/concat-changes changes changes2)]
|
||||
|
||||
(shape-cb shape)
|
||||
(:redo-changes changes)))
|
||||
|
||||
@@ -114,7 +114,7 @@
|
||||
(partial not-found-handler request)))
|
||||
|
||||
(on-error [cause request]
|
||||
(let [{:keys [::rres/body] :as response} (errors/handle cause request)]
|
||||
(let [{:keys [body] :as response} (errors/handle cause request)]
|
||||
(cond-> response
|
||||
(map? body)
|
||||
(-> (update ::rres/headers assoc "content-type" "application/transit+json")
|
||||
@@ -150,10 +150,10 @@
|
||||
[["" {:middleware [[mw/server-timing]
|
||||
[mw/params]
|
||||
[mw/format-response]
|
||||
[mw/errors errors/handle]
|
||||
[mw/parse-request]
|
||||
[session/soft-auth cfg]
|
||||
[actoken/soft-auth cfg]
|
||||
[mw/errors errors/handle]
|
||||
[mw/restrict-methods]]}
|
||||
|
||||
(::mtx/routes cfg)
|
||||
|
||||
@@ -10,13 +10,16 @@
|
||||
[app.common.logging :as l]
|
||||
[app.common.transit :as t]
|
||||
[app.config :as cf]
|
||||
[clojure.data.json :as json]
|
||||
[app.util.json :as json]
|
||||
[cuerdas.core :as str]
|
||||
[ring.request :as rreq]
|
||||
[ring.response :as rres]
|
||||
[yetti.adapter :as yt]
|
||||
[yetti.middleware :as ymw])
|
||||
(:import
|
||||
com.fasterxml.jackson.core.JsonParseException
|
||||
com.fasterxml.jackson.core.io.JsonEOFException
|
||||
com.fasterxml.jackson.databind.exc.MismatchedInputException
|
||||
io.undertow.server.RequestTooBigException
|
||||
java.io.InputStream
|
||||
java.io.OutputStream))
|
||||
@@ -31,22 +34,11 @@
|
||||
{:name ::params
|
||||
:compile (constantly ymw/wrap-params)})
|
||||
|
||||
(defn- get-reader
|
||||
^java.io.BufferedReader
|
||||
[request]
|
||||
(let [^InputStream body (rreq/body request)]
|
||||
(java.io.BufferedReader.
|
||||
(java.io.InputStreamReader. body))))
|
||||
|
||||
(defn- read-json-key
|
||||
[k]
|
||||
(-> k str/kebab keyword))
|
||||
|
||||
(defn- write-json-key
|
||||
[k]
|
||||
(if (or (keyword? k) (symbol? k))
|
||||
(str/camel k)
|
||||
(str k)))
|
||||
(def ^:private json-mapper
|
||||
(json/mapper
|
||||
{:encode-key-fn str/camel
|
||||
:decode-key-fn (comp keyword str/kebab)
|
||||
:pretty true}))
|
||||
|
||||
(defn wrap-parse-request
|
||||
[handler]
|
||||
@@ -61,8 +53,8 @@
|
||||
(update :params merge params))))
|
||||
|
||||
(str/starts-with? header "application/json")
|
||||
(with-open [reader (get-reader request)]
|
||||
(let [params (json/read reader :key-fn read-json-key)]
|
||||
(with-open [^InputStream is (rreq/body request)]
|
||||
(let [params (json/decode is json-mapper)]
|
||||
(-> request
|
||||
(assoc :body-params params)
|
||||
(update :params merge params))))
|
||||
@@ -82,7 +74,9 @@
|
||||
:code :request-body-too-large
|
||||
:hint (ex-message cause))
|
||||
|
||||
(instance? java.io.EOFException cause)
|
||||
(or (instance? JsonEOFException cause)
|
||||
(instance? JsonParseException cause)
|
||||
(instance? MismatchedInputException cause))
|
||||
(ex/raise :type :validation
|
||||
:code :malformed-json
|
||||
:hint (ex-message cause)
|
||||
@@ -134,8 +128,7 @@
|
||||
(-write-body-to-stream [_ _ output-stream]
|
||||
(try
|
||||
(with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
|
||||
(with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
|
||||
(json/write data writer :key-fn write-json-key)))
|
||||
(json/write! bos data json-mapper))
|
||||
|
||||
(catch java.io.IOException _)
|
||||
(catch Throwable cause
|
||||
|
||||
@@ -10,7 +10,6 @@
|
||||
[app.common.data :as d]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uri :as u]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as sql]
|
||||
@@ -34,7 +33,7 @@
|
||||
|
||||
;; A cookie that we can use to check from other sites of the same
|
||||
;; domain if a user is authenticated.
|
||||
(def default-auth-data-cookie-name "auth-data")
|
||||
(def default-authenticated-cookie-name "authenticated")
|
||||
|
||||
;; Default value for cookie max-age
|
||||
(def default-cookie-max-age (dt/duration {:days 7}))
|
||||
@@ -134,9 +133,9 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare ^:private assign-auth-token-cookie)
|
||||
(declare ^:private assign-auth-data-cookie)
|
||||
(declare ^:private assign-authenticated-cookie)
|
||||
(declare ^:private clear-auth-token-cookie)
|
||||
(declare ^:private clear-auth-data-cookie)
|
||||
(declare ^:private clear-authenticated-cookie)
|
||||
(declare ^:private gen-token)
|
||||
|
||||
(defn create-fn
|
||||
@@ -154,7 +153,7 @@
|
||||
(l/trace :hint "create" :profile-id (str profile-id))
|
||||
(-> response
|
||||
(assign-auth-token-cookie session)
|
||||
(assign-auth-data-cookie session)))))
|
||||
(assign-authenticated-cookie session)))))
|
||||
|
||||
(defn delete-fn
|
||||
[{:keys [::manager]}]
|
||||
@@ -168,7 +167,7 @@
|
||||
(assoc :status 204)
|
||||
(assoc :body nil)
|
||||
(clear-auth-token-cookie)
|
||||
(clear-auth-data-cookie)))))
|
||||
(clear-authenticated-cookie)))))
|
||||
|
||||
(defn- gen-token
|
||||
[props {:keys [profile-id created-at]}]
|
||||
@@ -230,7 +229,7 @@
|
||||
(let [session (update! manager session)]
|
||||
(-> response
|
||||
(assign-auth-token-cookie session)
|
||||
(assign-auth-data-cookie session)))
|
||||
(assign-authenticated-cookie session)))
|
||||
response))))
|
||||
|
||||
(def soft-auth
|
||||
@@ -263,11 +262,11 @@
|
||||
:secure secure?}]
|
||||
(update response :cookies assoc name cookie)))
|
||||
|
||||
(defn- assign-auth-data-cookie
|
||||
[response {profile-id :profile-id updated-at :updated-at}]
|
||||
(defn- assign-authenticated-cookie
|
||||
[response {updated-at :updated-at}]
|
||||
(let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)
|
||||
domain (cf/get :auth-data-cookie-domain)
|
||||
cname default-auth-data-cookie-name
|
||||
domain (cf/get :authenticated-cookie-domain)
|
||||
cname (cf/get :authenticated-cookie-name "authenticated")
|
||||
|
||||
created-at (or updated-at (dt/now))
|
||||
renewal (dt/plus created-at default-renewal-max-age)
|
||||
@@ -275,17 +274,14 @@
|
||||
|
||||
comment (str "Renewal at: " (dt/format-instant renewal :rfc1123))
|
||||
secure? (contains? cf/flags :secure-session-cookies)
|
||||
strict? (contains? cf/flags :strict-session-cookies)
|
||||
cors? (contains? cf/flags :cors)
|
||||
|
||||
cookie {:domain domain
|
||||
:expires expires
|
||||
:path "/"
|
||||
:comment comment
|
||||
:value (u/map->query-string {:profile-id profile-id})
|
||||
:same-site (if cors? :none (if strict? :strict :lax))
|
||||
:value true
|
||||
:same-site :strict
|
||||
:secure secure?}]
|
||||
|
||||
(cond-> response
|
||||
(string? domain)
|
||||
(update :cookies assoc cname cookie))))
|
||||
@@ -295,10 +291,10 @@
|
||||
(let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
|
||||
(update response :cookies assoc cname {:path "/" :value "" :max-age 0})))
|
||||
|
||||
(defn- clear-auth-data-cookie
|
||||
(defn- clear-authenticated-cookie
|
||||
[response]
|
||||
(let [cname default-auth-data-cookie-name
|
||||
domain (cf/get :auth-data-cookie-domain)]
|
||||
(let [cname (cf/get :authenticated-cookie-name default-authenticated-cookie-name)
|
||||
domain (cf/get :authenticated-cookie-domain)]
|
||||
(cond-> response
|
||||
(string? domain)
|
||||
(update :cookies assoc cname {:domain domain :path "/" :value "" :max-age 0}))))
|
||||
|
||||
@@ -61,8 +61,6 @@
|
||||
(let [result (handler)]
|
||||
(events/tap :end result))
|
||||
(catch Throwable cause
|
||||
(l/err :hint "unexpected error on processing sse response"
|
||||
:cause cause)
|
||||
(events/tap :error (errors/handle' cause request)))
|
||||
(finally
|
||||
(sp/close! events/*channel*)
|
||||
|
||||
@@ -53,7 +53,8 @@
|
||||
(assoc (->> sk str/kebab (keyword "penpot")) v))))]
|
||||
(reduce-kv process-param {} params)))
|
||||
|
||||
(def profile-props
|
||||
(def ^:private
|
||||
profile-props
|
||||
[:id
|
||||
:is-active
|
||||
:is-muted
|
||||
@@ -86,14 +87,6 @@
|
||||
(remove #(contains? reserved-props (key %))))
|
||||
props))
|
||||
|
||||
(defn params->context
|
||||
"Extract default context properties from RPC params object"
|
||||
[params]
|
||||
(d/without-nils
|
||||
{:external-session-id (::rpc/external-session-id params)
|
||||
:event-origin (::rpc/external-event-origin params)
|
||||
:triggered-by (::rpc/handler-name params)}))
|
||||
|
||||
;; --- SPECS
|
||||
|
||||
|
||||
@@ -148,20 +141,16 @@
|
||||
(::rpc/profile-id params)
|
||||
uuid/zero)
|
||||
|
||||
session-id (get params ::rpc/external-session-id)
|
||||
event-origin (get params ::rpc/external-event-origin)
|
||||
props (-> (or (::replace-props resultm)
|
||||
(-> params
|
||||
(merge (::props resultm))
|
||||
(dissoc :profile-id)
|
||||
(dissoc :type)))
|
||||
props (-> (or (::replace-props resultm)
|
||||
(-> params
|
||||
(merge (::props resultm))
|
||||
(dissoc :profile-id)
|
||||
(dissoc :type)))
|
||||
|
||||
(clean-props))
|
||||
(clean-props))
|
||||
|
||||
token-id (::actoken/id request)
|
||||
context (-> (::context resultm)
|
||||
(assoc :external-session-id session-id)
|
||||
(assoc :external-event-origin event-origin)
|
||||
(assoc :access-token-id (some-> token-id str))
|
||||
(d/without-nils))]
|
||||
|
||||
@@ -244,16 +233,18 @@
|
||||
:else label)
|
||||
dedupe? (boolean (and batch-key batch-timeout))]
|
||||
|
||||
(wrk/submit! (-> cfg
|
||||
(assoc ::wrk/task :process-webhook-event)
|
||||
(assoc ::wrk/queue :webhooks)
|
||||
(assoc ::wrk/max-retries 0)
|
||||
(assoc ::wrk/delay (or batch-timeout 0))
|
||||
(assoc ::wrk/dedupe dedupe?)
|
||||
(assoc ::wrk/label label)
|
||||
(assoc ::wrk/params (-> params
|
||||
(dissoc :ip-addr)
|
||||
(dissoc :type)))))))
|
||||
(wrk/submit! ::wrk/conn (::db/conn cfg)
|
||||
::wrk/task :process-webhook-event
|
||||
::wrk/queue :webhooks
|
||||
::wrk/max-retries 0
|
||||
::wrk/delay (or batch-timeout 0)
|
||||
::wrk/dedupe dedupe?
|
||||
::wrk/label label
|
||||
|
||||
::webhooks/event
|
||||
(-> params
|
||||
(dissoc :ip-addr)
|
||||
(dissoc :type)))))
|
||||
params))
|
||||
|
||||
(defn submit!
|
||||
|
||||
@@ -64,22 +64,22 @@
|
||||
(s/keys :req [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::process-event-handler
|
||||
[_ cfg]
|
||||
[_ {:keys [::db/pool] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [event (:event props)]
|
||||
(let [event (::event props)]
|
||||
(l/dbg :hint "process webhook event" :name (:name event))
|
||||
|
||||
(when-let [items (lookup-webhooks cfg event)]
|
||||
(l/trc :hint "webhooks found for event" :total (count items))
|
||||
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(doseq [item items]
|
||||
(wrk/submit! (-> cfg
|
||||
(assoc ::wrk/task :run-webhook)
|
||||
(assoc ::wrk/queue :webhooks)
|
||||
(assoc ::wrk/max-retries 3)
|
||||
(assoc ::wrk/params {:event event
|
||||
:config item}))))))))))
|
||||
(db/with-atomic [conn pool]
|
||||
(doseq [item items]
|
||||
(wrk/submit! ::wrk/conn conn
|
||||
::wrk/task :run-webhook
|
||||
::wrk/queue :webhooks
|
||||
::wrk/max-retries 3
|
||||
::event event
|
||||
::config item)))))))
|
||||
|
||||
;; --- RUN
|
||||
|
||||
@@ -128,8 +128,8 @@
|
||||
:rsp-data (db/tjson rsp)}))]
|
||||
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [event (:event props)
|
||||
whook (:config props)
|
||||
(let [event (::event props)
|
||||
whook (::config props)
|
||||
|
||||
body (case (:mtype whook)
|
||||
"application/json" (json/write-str event json-write-opts)
|
||||
|
||||
@@ -102,13 +102,13 @@
|
||||
{::mdef/name "penpot_tasks_timing"
|
||||
::mdef/help "Background tasks timing (milliseconds)."
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :histogram}
|
||||
::mdef/type :summary}
|
||||
|
||||
:redis-eval-timing
|
||||
{::mdef/name "penpot_redis_eval_timing"
|
||||
::mdef/help "Redis EVAL commands execution timings (ms)"
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :histogram}
|
||||
::mdef/type :summary}
|
||||
|
||||
:rpc-climit-queue
|
||||
{::mdef/name "penpot_rpc_climit_queue"
|
||||
@@ -126,7 +126,7 @@
|
||||
{::mdef/name "penpot_rpc_climit_timing"
|
||||
::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
|
||||
::mdef/labels ["name"]
|
||||
::mdef/type :histogram}
|
||||
::mdef/type :summary}
|
||||
|
||||
:audit-http-handler-queue-size
|
||||
{::mdef/name "penpot_audit_http_handler_queue_size"
|
||||
@@ -144,7 +144,7 @@
|
||||
{::mdef/name "penpot_audit_http_handler_timing"
|
||||
::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
|
||||
::mdef/labels []
|
||||
::mdef/type :histogram}
|
||||
::mdef/type :summary}
|
||||
|
||||
:executors-active-threads
|
||||
{::mdef/name "penpot_executors_active_threads"
|
||||
@@ -267,9 +267,7 @@
|
||||
:github (ig/ref ::oidc.providers/github)
|
||||
:gitlab (ig/ref ::oidc.providers/gitlab)
|
||||
:oidc (ig/ref ::oidc.providers/generic)}
|
||||
::session/manager (ig/ref ::session/manager)
|
||||
::email/blacklist (ig/ref ::email/blacklist)
|
||||
::email/whitelist (ig/ref ::email/whitelist)}
|
||||
::session/manager (ig/ref ::session/manager)}
|
||||
|
||||
:app.http/router
|
||||
{::session/manager (ig/ref ::session/manager)
|
||||
@@ -324,10 +322,7 @@
|
||||
::rpc/climit (ig/ref ::rpc/climit)
|
||||
::rpc/rlimit (ig/ref ::rpc/rlimit)
|
||||
::setup/templates (ig/ref ::setup/templates)
|
||||
::setup/props (ig/ref ::setup/props)
|
||||
|
||||
::email/blacklist (ig/ref ::email/blacklist)
|
||||
::email/whitelist (ig/ref ::email/whitelist)}
|
||||
::setup/props (ig/ref ::setup/props)}
|
||||
|
||||
:app.rpc.doc/routes
|
||||
{:methods (ig/ref :app.rpc/methods)}
|
||||
@@ -343,6 +338,7 @@
|
||||
::wrk/tasks
|
||||
{:sendmail (ig/ref ::email/handler)
|
||||
:objects-gc (ig/ref :app.tasks.objects-gc/handler)
|
||||
:orphan-teams-gc (ig/ref :app.tasks.orphan-teams-gc/handler)
|
||||
:file-gc (ig/ref :app.tasks.file-gc/handler)
|
||||
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
|
||||
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
|
||||
@@ -353,19 +349,13 @@
|
||||
:audit-log-archive (ig/ref :app.loggers.audit.archive-task/handler)
|
||||
:audit-log-gc (ig/ref :app.loggers.audit.gc-task/handler)
|
||||
|
||||
:delete-object
|
||||
(ig/ref :app.tasks.delete-object/handler)
|
||||
:object-update
|
||||
(ig/ref :app.tasks.object-update/handler)
|
||||
:process-webhook-event
|
||||
(ig/ref ::webhooks/process-event-handler)
|
||||
:run-webhook
|
||||
(ig/ref ::webhooks/run-webhook-handler)}}
|
||||
|
||||
::email/blacklist
|
||||
{}
|
||||
|
||||
::email/whitelist
|
||||
{}
|
||||
|
||||
::email/sendmail
|
||||
{::email/host (cf/get :smtp-host)
|
||||
::email/port (cf/get :smtp-port)
|
||||
@@ -387,7 +377,10 @@
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::sto/storage (ig/ref ::sto/storage)}
|
||||
|
||||
:app.tasks.delete-object/handler
|
||||
:app.tasks.orphan-teams-gc/handler
|
||||
{::db/pool (ig/ref ::db/pool)}
|
||||
|
||||
:app.tasks.object-update/handler
|
||||
{::db/pool (ig/ref ::db/pool)}
|
||||
|
||||
:app.tasks.file-gc/handler
|
||||
@@ -475,6 +468,9 @@
|
||||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :objects-gc}
|
||||
|
||||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :orphan-teams-gc}
|
||||
|
||||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :storage-gc-deleted}
|
||||
|
||||
|
||||
@@ -79,14 +79,8 @@
|
||||
profile-id (or (::session/profile-id request)
|
||||
(::actoken/profile-id request))
|
||||
|
||||
session-id (rreq/get-header request "x-external-session-id")
|
||||
event-origin (rreq/get-header request "x-event-origin")
|
||||
|
||||
data (-> params
|
||||
(assoc ::handler-name handler-name)
|
||||
(assoc ::request-at (dt/now))
|
||||
(assoc ::external-session-id session-id)
|
||||
(assoc ::external-event-origin event-origin)
|
||||
(assoc ::session/id (::session/id request))
|
||||
(assoc ::cond/key etag)
|
||||
(cond-> (uuid? profile-id)
|
||||
@@ -194,10 +188,10 @@
|
||||
(defn- wrap-all
|
||||
[cfg f mdata]
|
||||
(as-> f $
|
||||
(wrap-metrics cfg $ mdata)
|
||||
(cond/wrap cfg $ mdata)
|
||||
(retry/wrap-retry cfg $ mdata)
|
||||
(climit/wrap cfg $ mdata)
|
||||
(wrap-metrics cfg $ mdata)
|
||||
(rlimit/wrap cfg $ mdata)
|
||||
(wrap-audit cfg $ mdata)
|
||||
(wrap-spec-conform cfg $ mdata)
|
||||
|
||||
@@ -77,19 +77,10 @@
|
||||
(when (seq events)
|
||||
(db/insert-many! pool :audit-log event-columns events))))
|
||||
|
||||
(def valid-event-types
|
||||
#{"action" "identify"})
|
||||
|
||||
(def schema:event
|
||||
[:map {:title "Event"}
|
||||
[:name
|
||||
[:and {:gen/elements ["update-file", "get-profile"]}
|
||||
[:string {:max 250}]
|
||||
[:re #"[\d\w-]{1,50}"]]]
|
||||
[:type
|
||||
[:and {:gen/elements valid-event-types}
|
||||
[:string {:max 250}]
|
||||
[::sm/one-of {:format "string"} valid-event-types]]]
|
||||
[:name [:string {:max 250}]]
|
||||
[:type [:string {:max 250}]]
|
||||
[:props
|
||||
[:map-of :keyword :any]]
|
||||
[:context {:optional true}
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
|
||||
(ns app.rpc.commands.auth
|
||||
(:require
|
||||
[app.auth :as auth]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
@@ -16,8 +17,6 @@
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.email :as eml]
|
||||
[app.email.blacklist :as email.blacklist]
|
||||
[app.email.whitelist :as email.whitelist]
|
||||
[app.http.session :as session]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.rpc :as-alias rpc]
|
||||
@@ -38,11 +37,13 @@
|
||||
(def schema:token
|
||||
[::sm/word-string {:max 6000}])
|
||||
|
||||
(def ^:private default-verify-threshold
|
||||
(dt/duration "15m"))
|
||||
|
||||
(defn- elapsed-verify-threshold?
|
||||
[profile]
|
||||
(let [elapsed (dt/diff (:modified-at profile) (dt/now))
|
||||
verify-threshold (cf/get :email-verify-threshold)]
|
||||
(pos? (compare elapsed verify-threshold))))
|
||||
(let [elapsed (dt/diff (:modified-at profile) (dt/now))]
|
||||
(pos? (compare elapsed default-verify-threshold))))
|
||||
|
||||
;; ---- COMMAND: login with password
|
||||
|
||||
@@ -128,21 +129,12 @@
|
||||
|
||||
;; ---- COMMAND: Logout
|
||||
|
||||
(def ^:private schema:logout
|
||||
[:map {:title "logoug"}
|
||||
[:profile-id {:optional true} ::sm/uuid]])
|
||||
|
||||
(sv/defmethod ::logout
|
||||
"Clears the authentication cookie and logout the current session."
|
||||
{::rpc/auth false
|
||||
::doc/changes [["2.1" "Now requires profile-id passed in the body"]]
|
||||
::doc/added "1.0"
|
||||
::sm/params schema:logout}
|
||||
[cfg params]
|
||||
(if (= (:profile-id params)
|
||||
(::rpc/profile-id params))
|
||||
(rph/with-transform {} (session/delete-fn cfg))
|
||||
{}))
|
||||
::doc/added "1.15"}
|
||||
[cfg _]
|
||||
(rph/with-transform {} (session/delete-fn cfg)))
|
||||
|
||||
;; ---- COMMAND: Recover Profile
|
||||
|
||||
@@ -194,14 +186,8 @@
|
||||
:code :email-does-not-match-invitation
|
||||
:hint "email should match the invitation"))))
|
||||
|
||||
(when (and (email.blacklist/enabled? cfg)
|
||||
(email.blacklist/contains? cfg (:email params)))
|
||||
(ex/raise :type :restriction
|
||||
:code :email-domain-is-not-allowed))
|
||||
|
||||
(when (and (email.whitelist/enabled? cfg)
|
||||
(not (email.whitelist/contains? cfg (:email params))))
|
||||
(ex/raise :type :restriction
|
||||
(when-not (auth/email-domain-in-whitelist? (:email params))
|
||||
(ex/raise :type :validation
|
||||
:code :email-domain-is-not-allowed))
|
||||
|
||||
;; Perform a basic validation of email & password
|
||||
@@ -437,8 +423,10 @@
|
||||
::doc/added "1.15"
|
||||
::sm/params schema:register-profile
|
||||
::climit/id :auth/global}
|
||||
[cfg params]
|
||||
(db/tx-run! cfg register-profile params))
|
||||
[{:keys [::db/pool] :as cfg} params]
|
||||
(db/with-atomic [conn pool]
|
||||
(-> (assoc cfg ::db/conn conn)
|
||||
(register-profile params))))
|
||||
|
||||
;; ---- COMMAND: Request Profile Recovery
|
||||
|
||||
|
||||
@@ -30,12 +30,14 @@
|
||||
|
||||
;; --- Command: export-binfile
|
||||
|
||||
(def ^:private schema:export-binfile
|
||||
[:map {:title "export-binfile"}
|
||||
[:name :string]
|
||||
[:file-id ::sm/uuid]
|
||||
[:include-libraries :boolean]
|
||||
[:embed-assets :boolean]])
|
||||
(def ^:private
|
||||
schema:export-binfile
|
||||
(sm/define
|
||||
[:map {:title "export-binfile"}
|
||||
[:name :string]
|
||||
[:file-id ::sm/uuid]
|
||||
[:include-libraries :boolean]
|
||||
[:embed-assets :boolean]]))
|
||||
|
||||
(sv/defmethod ::export-binfile
|
||||
"Export a penpot file in a binary format."
|
||||
@@ -74,11 +76,13 @@
|
||||
{:id project-id})
|
||||
result))
|
||||
|
||||
(def ^:private schema:import-binfile
|
||||
[:map {:title "import-binfile"}
|
||||
[:name :string]
|
||||
[:project-id ::sm/uuid]
|
||||
[:file ::media/upload]])
|
||||
(def ^:private
|
||||
schema:import-binfile
|
||||
(sm/define
|
||||
[:map {:title "import-binfile"}
|
||||
[:name :string]
|
||||
[:project-id ::sm/uuid]
|
||||
[:file ::media/upload]]))
|
||||
|
||||
(sv/defmethod ::import-binfile
|
||||
"Import a penpot file in a binary format."
|
||||
|
||||
@@ -35,7 +35,6 @@
|
||||
[app.util.pointer-map :as pmap]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
@@ -823,7 +822,7 @@
|
||||
|
||||
(feat.fdata/persist-pointers! cfg file-id))))
|
||||
|
||||
(defn- absorb-library
|
||||
(defn- absorb-library!
|
||||
"Find all files using a shared library, and absorb all library assets
|
||||
into the file local libraries"
|
||||
[cfg {:keys [id] :as library}]
|
||||
@@ -841,26 +840,7 @@
|
||||
:library-id (str id)
|
||||
:files (str/join "," (map str ids)))
|
||||
|
||||
(run! (partial absorb-library-by-file! cfg ldata) ids)
|
||||
library))
|
||||
|
||||
(defn absorb-library!
|
||||
[{:keys [::db/conn] :as cfg} id]
|
||||
(let [file (-> (get-file cfg id
|
||||
:lock-for-update? true
|
||||
:include-deleted? true)
|
||||
(check-version!))
|
||||
|
||||
proj (db/get* conn :project {:id (:project-id file)}
|
||||
{::db/remove-deleted false})
|
||||
team (-> (db/get* conn :team {:id (:team-id proj)}
|
||||
{::db/remove-deleted false})
|
||||
(teams/decode-row))]
|
||||
|
||||
(-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
(absorb-library cfg file)))
|
||||
(run! (partial absorb-library-by-file! cfg ldata) ids)))
|
||||
|
||||
(defn- set-file-shared
|
||||
[{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
|
||||
@@ -873,14 +853,25 @@
|
||||
;; file, we need to perform more complex operation,
|
||||
;; so in this case we retrieve the complete file and
|
||||
;; perform all required validations.
|
||||
(let [file (-> (absorb-library! cfg id)
|
||||
(assoc :is-shared false))]
|
||||
(let [file (-> (get-file cfg id :lock-for-update? true)
|
||||
(check-version!)
|
||||
(assoc :is-shared false))
|
||||
team (teams/get-team conn
|
||||
:profile-id profile-id
|
||||
:project-id (:project-id file))]
|
||||
|
||||
(-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
(absorb-library! cfg file)
|
||||
|
||||
(db/delete! conn :file-library-rel {:library-file-id id})
|
||||
(db/update! conn :file
|
||||
{:is-shared false
|
||||
:modified-at (dt/now)}
|
||||
{:id id})
|
||||
(select-keys file [:id :name :is-shared]))
|
||||
file)
|
||||
|
||||
(and (false? (:is-shared file))
|
||||
(true? (:is-shared params)))
|
||||
@@ -920,19 +911,12 @@
|
||||
|
||||
;; --- MUTATION COMMAND: delete-file
|
||||
|
||||
(defn- mark-file-deleted
|
||||
(defn- mark-file-deleted!
|
||||
[conn file-id]
|
||||
(let [file (db/update! conn :file
|
||||
{:deleted-at (dt/now)}
|
||||
{:id file-id}
|
||||
{::db/return-keys [:id :name :is-shared :deleted-at
|
||||
:project-id :created-at :modified-at]})]
|
||||
(wrk/submit! {::db/conn conn
|
||||
::wrk/task :delete-object
|
||||
::wrk/params {:object :file
|
||||
:deleted-at (:deleted-at file)
|
||||
:id file-id}})
|
||||
file))
|
||||
(db/update! conn :file
|
||||
{:deleted-at (dt/now)}
|
||||
{:id file-id}
|
||||
{::db/return-keys [:id :name :is-shared :project-id :created-at :modified-at]}))
|
||||
|
||||
(def ^:private
|
||||
schema:delete-file
|
||||
@@ -943,7 +927,29 @@
|
||||
(defn- delete-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}]
|
||||
(check-edition-permissions! conn profile-id id)
|
||||
(let [file (mark-file-deleted conn id)]
|
||||
(let [file (mark-file-deleted! conn id)]
|
||||
|
||||
;; NOTE: when a file is a shared library, then we proceed to load
|
||||
;; the whole file, proceed with feature checking and properly execute
|
||||
;; the absorb-library procedure
|
||||
(when (:is-shared file)
|
||||
(let [file (-> (get-file cfg id
|
||||
:lock-for-update? true
|
||||
:include-deleted? true)
|
||||
(check-version!))
|
||||
|
||||
team (teams/get-team conn
|
||||
:profile-id profile-id
|
||||
:project-id (:project-id file))]
|
||||
|
||||
|
||||
|
||||
(-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
(absorb-library! cfg file)))
|
||||
|
||||
(rph/with-meta (rph/wrap)
|
||||
{::audit/props {:project-id (:project-id file)
|
||||
:name (:name file)
|
||||
|
||||
@@ -6,10 +6,13 @@
|
||||
|
||||
(ns app.rpc.commands.files-create
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.defaults :refer [version]]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.features.fdata :as feat.fdata]
|
||||
@@ -37,7 +40,7 @@
|
||||
(defn create-file
|
||||
[{:keys [::db/conn] :as cfg}
|
||||
{:keys [id name project-id is-shared revn
|
||||
modified-at deleted-at create-page page-id
|
||||
modified-at deleted-at create-page
|
||||
ignore-sync-until features]
|
||||
:or {is-shared false revn 0 create-page true}
|
||||
:as params}]
|
||||
@@ -48,17 +51,23 @@
|
||||
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)
|
||||
cfeat/*current* features]
|
||||
(let [file (ctf/make-file {:id id
|
||||
:project-id project-id
|
||||
:name name
|
||||
:revn revn
|
||||
:is-shared is-shared
|
||||
:features features
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at
|
||||
:create-page create-page
|
||||
:page-id page-id})
|
||||
(let [id (or id (uuid/next))
|
||||
|
||||
data (if create-page
|
||||
(ctf/make-file-data id)
|
||||
(ctf/make-file-data id nil))
|
||||
|
||||
file {:id id
|
||||
:project-id project-id
|
||||
:name name
|
||||
:revn revn
|
||||
:is-shared is-shared
|
||||
:version version
|
||||
:data data
|
||||
:features features
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at}
|
||||
|
||||
file (if (contains? features "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
@@ -66,7 +75,9 @@
|
||||
|
||||
file (if (contains? features "fdata/pointer-map")
|
||||
(feat.fdata/enable-pointer-map file)
|
||||
file)]
|
||||
file)
|
||||
|
||||
file (d/without-nils file)]
|
||||
|
||||
(db/insert! conn :file
|
||||
(-> file
|
||||
@@ -75,9 +86,9 @@
|
||||
{::db/return-keys false})
|
||||
|
||||
(when (contains? features "fdata/pointer-map")
|
||||
(feat.fdata/persist-pointers! cfg (:id file)))
|
||||
(feat.fdata/persist-pointers! cfg id))
|
||||
|
||||
(->> (assoc params :file-id (:id file) :role :owner)
|
||||
(->> (assoc params :file-id id :role :owner)
|
||||
(create-file-role! conn))
|
||||
|
||||
(db/update! conn :project
|
||||
|
||||
@@ -16,7 +16,6 @@
|
||||
[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]
|
||||
[app.rpc.commands.files :as files]
|
||||
[app.rpc.commands.files-create :as files.create]
|
||||
@@ -24,7 +23,6 @@
|
||||
[app.rpc.commands.projects :as projects]
|
||||
[app.rpc.commands.teams :as teams]
|
||||
[app.rpc.doc :as-alias doc]
|
||||
[app.rpc.helpers :as rph]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.pointer-map :as pmap]
|
||||
[app.util.services :as sv]
|
||||
@@ -102,9 +100,7 @@
|
||||
:revn revn
|
||||
:data nil
|
||||
:changes (blob/encode changes)})
|
||||
(rph/with-meta (rph/wrap nil)
|
||||
{::audit/replace-props {:file-id id
|
||||
:revn revn}}))))
|
||||
nil)))
|
||||
|
||||
;; --- MUTATION COMMAND: persist-temp-file
|
||||
|
||||
|
||||
@@ -87,7 +87,10 @@
|
||||
::sm/params [:map {:title "get-file-object-thumbnails"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:tag {:optional true} :string]]
|
||||
::sm/result [:map-of :string :string]}
|
||||
::sm/result [:map-of :string :string]
|
||||
::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
|
||||
::cond/reuse-key? true
|
||||
::cond/key-fn files/get-file-etag}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id tag] :as params}]
|
||||
(dm/with-open [conn (db/open pool)]
|
||||
(files/check-read-permissions! conn profile-id file-id)
|
||||
@@ -268,7 +271,7 @@
|
||||
(when (and (some? th1)
|
||||
(not= (:media-id th1)
|
||||
(:media-id th2)))
|
||||
(sto/touch-object! storage (:media-id th1)))
|
||||
(sto/touch-object! storage (:media-id th1) :async true))
|
||||
|
||||
th2))
|
||||
|
||||
@@ -321,14 +324,18 @@
|
||||
(sv/defmethod ::delete-file-object-thumbnail
|
||||
{::doc/added "1.19"
|
||||
::doc/module :files
|
||||
::doc/deprecated "1.20"
|
||||
::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
|
||||
[:file-thumbnail-ops/global]]
|
||||
::audit/skip true}
|
||||
[cfg {:keys [::rpc/profile-id file-id object-id]}]
|
||||
(files/check-edition-permissions! cfg profile-id file-id)
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage conn)
|
||||
(delete-file-object-thumbnail! file-id object-id))
|
||||
nil)))
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(when-not (db/read-only? conn)
|
||||
(-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage conn)
|
||||
(delete-file-object-thumbnail! file-id object-id))
|
||||
nil))))
|
||||
|
||||
;; --- MUTATION COMMAND: create-file-thumbnail
|
||||
|
||||
|
||||
@@ -262,8 +262,8 @@
|
||||
;; Send asynchronous notifications
|
||||
(send-notifications! cfg params)
|
||||
|
||||
{:revn (:revn file)
|
||||
:lagged (get-lagged-changes conn params)})))
|
||||
;; Retrieve and return lagged data
|
||||
(get-lagged-changes conn params))))
|
||||
|
||||
(defn- soft-validate-file-schema!
|
||||
[file]
|
||||
@@ -324,21 +324,19 @@
|
||||
(update :data cpc/process-changes changes)
|
||||
(update :data d/without-nils))]
|
||||
|
||||
(when (contains? cf/flags :soft-file-validation)
|
||||
(soft-validate-file! file libs))
|
||||
|
||||
(binding [pmap/*tracked* nil]
|
||||
(when (contains? cf/flags :soft-file-validation)
|
||||
(soft-validate-file! file libs))
|
||||
(when (contains? cf/flags :soft-file-schema-validation)
|
||||
(soft-validate-file-schema! file))
|
||||
|
||||
(when (contains? cf/flags :soft-file-schema-validation)
|
||||
(soft-validate-file-schema! file))
|
||||
(when (and (contains? cf/flags :file-validation)
|
||||
(not skip-validate))
|
||||
(val/validate-file! file libs))
|
||||
|
||||
(when (and (contains? cf/flags :file-validation)
|
||||
(not skip-validate))
|
||||
(val/validate-file! file libs))
|
||||
|
||||
(when (and (contains? cf/flags :file-schema-validation)
|
||||
(not skip-validate))
|
||||
(val/validate-file-schema! file)))
|
||||
(when (and (contains? cf/flags :file-schema-validation)
|
||||
(not skip-validate))
|
||||
(val/validate-file-schema! file))
|
||||
|
||||
(cond-> file
|
||||
(contains? cfeat/*current* "fdata/objects-map")
|
||||
|
||||
@@ -16,7 +16,6 @@
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.http.sse :as sse]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.loggers.webhooks :as-alias webhooks]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.rpc.commands.files :as files]
|
||||
@@ -398,32 +397,17 @@
|
||||
;; --- COMMAND: Clone Template
|
||||
|
||||
(defn- clone-template
|
||||
[cfg {:keys [project-id ::rpc/profile-id] :as params} template]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn ::wrk/executor] :as cfg}]
|
||||
[{:keys [::wrk/executor ::bf.v1/project-id] :as cfg} template]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
;; NOTE: the importation process performs some operations that
|
||||
;; are not very friendly with virtual threads, and for avoid
|
||||
;; unexpected blocking of other concurrent operations we
|
||||
;; dispatch that operation to a dedicated executor.
|
||||
(let [cfg (-> cfg
|
||||
(assoc ::bf.v1/project-id project-id)
|
||||
(assoc ::bf.v1/profile-id profile-id))
|
||||
result (px/invoke! executor (partial bf.v1/import-files! cfg template))]
|
||||
|
||||
(let [result (px/submit! executor (partial bf.v1/import-files! cfg template))]
|
||||
(db/update! conn :project
|
||||
{:modified-at (dt/now)}
|
||||
{:id project-id})
|
||||
|
||||
(let [props (audit/clean-props params)
|
||||
context (audit/params->context params)]
|
||||
(doseq [file-id result]
|
||||
(audit/submit! cfg
|
||||
{::audit/type "action"
|
||||
::audit/name "create-file"
|
||||
::audit/profile-id profile-id
|
||||
::audit/props (assoc props :id file-id)
|
||||
::audit/context context})))
|
||||
|
||||
result))))
|
||||
(deref result)))))
|
||||
|
||||
(def ^:private
|
||||
schema:clone-template
|
||||
@@ -441,14 +425,16 @@
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id template-id] :as params}]
|
||||
(let [project (db/get-by-id pool :project project-id {:columns [:id :team-id]})
|
||||
_ (teams/check-edition-permissions! pool profile-id (:team-id project))
|
||||
template (tmpl/get-template-stream cfg template-id)]
|
||||
|
||||
template (tmpl/get-template-stream cfg template-id)
|
||||
params (-> cfg
|
||||
(assoc ::bf.v1/project-id (:id project))
|
||||
(assoc ::bf.v1/profile-id profile-id))]
|
||||
(when-not template
|
||||
(ex/raise :type :not-found
|
||||
:code :template-not-found
|
||||
:hint "template not found"))
|
||||
|
||||
(sse/response #(clone-template cfg params template))))
|
||||
(sse/response #(clone-template params template))))
|
||||
|
||||
;; --- COMMAND: Get list of builtin templates
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
[app.tokens :as tokens]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[app.worker :as-alias wrk]
|
||||
[cuerdas.core :as str]
|
||||
[promesa.exec :as px]))
|
||||
|
||||
@@ -110,6 +110,7 @@
|
||||
::sm/params schema:update-profile
|
||||
::sm/result schema:profile}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
|
||||
|
||||
(db/with-atomic [conn pool]
|
||||
;; NOTE: we need to retrieve the profile independently if we use
|
||||
;; it or not for explicit locking and avoid concurrent updates of
|
||||
@@ -366,13 +367,13 @@
|
||||
|
||||
;; --- MUTATION: Delete Profile
|
||||
|
||||
(declare ^:private get-owned-teams)
|
||||
(declare ^:private get-owned-teams-with-participants)
|
||||
|
||||
(sv/defmethod ::delete-profile
|
||||
{::doc/added "1.0"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [teams (get-owned-teams conn profile-id)
|
||||
(let [teams (get-owned-teams-with-participants conn profile-id)
|
||||
deleted-at (dt/now)]
|
||||
|
||||
;; If we found owned teams with participants, we don't allow
|
||||
@@ -384,39 +385,37 @@
|
||||
:hint "The user need to transfer ownership of owned teams."
|
||||
:context {:teams (mapv :id teams)}))
|
||||
|
||||
;; Mark profile deleted immediatelly
|
||||
(doseq [{:keys [id]} teams]
|
||||
(db/update! conn :team
|
||||
{:deleted-at deleted-at}
|
||||
{:id id}))
|
||||
|
||||
(db/update! conn :profile
|
||||
{:deleted-at deleted-at}
|
||||
{:id profile-id})
|
||||
|
||||
;; Schedule cascade deletion to a worker
|
||||
(wrk/submit! {::db/conn conn
|
||||
::wrk/task :delete-object
|
||||
::wrk/params {:object :profile
|
||||
:deleted-at deleted-at
|
||||
:id profile-id}})
|
||||
|
||||
(rph/with-transform {} (session/delete-fn cfg)))))
|
||||
|
||||
|
||||
;; --- HELPERS
|
||||
|
||||
(def sql:owned-teams
|
||||
"WITH owner_teams AS (
|
||||
SELECT tpr.team_id AS id
|
||||
FROM team_profile_rel AS tpr
|
||||
WHERE tpr.is_owner IS TRUE
|
||||
AND tpr.profile_id = ?
|
||||
"with owner_teams as (
|
||||
select tpr.team_id as id
|
||||
from team_profile_rel as tpr
|
||||
where tpr.is_owner is true
|
||||
and tpr.profile_id = ?
|
||||
)
|
||||
SELECT tpr.team_id AS id,
|
||||
count(tpr.profile_id) - 1 AS participants
|
||||
FROM team_profile_rel AS tpr
|
||||
WHERE tpr.team_id IN (SELECT id from owner_teams)
|
||||
GROUP BY 1")
|
||||
select tpr.team_id as id,
|
||||
count(tpr.profile_id) - 1 as participants
|
||||
from team_profile_rel as tpr
|
||||
where tpr.team_id in (select id from owner_teams)
|
||||
and tpr.profile_id != ?
|
||||
group by 1")
|
||||
|
||||
(defn get-owned-teams
|
||||
(defn- get-owned-teams-with-participants
|
||||
[conn profile-id]
|
||||
(db/exec! conn [sql:owned-teams profile-id]))
|
||||
(db/exec! conn [sql:owned-teams profile-id profile-id]))
|
||||
|
||||
(def ^:private sql:profile-existence
|
||||
"select exists (select * from profile
|
||||
|
||||
@@ -7,7 +7,6 @@
|
||||
(ns app.rpc.commands.projects
|
||||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.spec :as us]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
@@ -21,7 +20,6 @@
|
||||
[app.rpc.quotes :as quotes]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]))
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
@@ -246,39 +244,28 @@
|
||||
|
||||
;; --- MUTATION: Delete Project
|
||||
|
||||
(defn- delete-project
|
||||
[conn project-id]
|
||||
(let [project (db/update! conn :project
|
||||
{:deleted-at (dt/now)}
|
||||
{:id project-id}
|
||||
{::db/return-keys true})]
|
||||
|
||||
(when (:is-default project)
|
||||
(ex/raise :type :validation
|
||||
:code :non-deletable-project
|
||||
:hint "impossible to delete default project"))
|
||||
|
||||
(wrk/submit! {::db/conn conn
|
||||
::wrk/task :delete-object
|
||||
::wrk/params {:object :project
|
||||
:deleted-at (:deleted-at project)
|
||||
:id project-id}})
|
||||
|
||||
project))
|
||||
|
||||
(s/def ::delete-project
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::id]))
|
||||
|
||||
;; TODO: right now, we just don't allow delete default projects, in a
|
||||
;; future we need to ensure raise a correct exception signaling that
|
||||
;; this is not allowed.
|
||||
|
||||
(sv/defmethod ::delete-project
|
||||
{::doc/added "1.18"
|
||||
::webhooks/event? true}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(check-edition-permissions! conn profile-id id)
|
||||
(let [project (delete-project conn id)]
|
||||
(let [project (db/update! conn :project
|
||||
{:deleted-at (dt/now)}
|
||||
{:id id :is-default false}
|
||||
{::db/return-keys true})]
|
||||
(rph/with-meta (rph/wrap)
|
||||
{::audit/props {:team-id (:team-id project)
|
||||
:name (:name project)
|
||||
:created-at (:created-at project)
|
||||
:modified-at (:modified-at project)}}))))
|
||||
|
||||
|
||||
|
||||
@@ -12,6 +12,7 @@
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.logging :as l]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
@@ -30,11 +31,16 @@
|
||||
[app.tokens :as tokens]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
;; --- Helpers & Specs
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::file-id ::us/uuid)
|
||||
(s/def ::team-id ::us/uuid)
|
||||
|
||||
(def ^:private sql:team-permissions
|
||||
"select tpr.is_owner,
|
||||
tpr.is_admin,
|
||||
@@ -344,7 +350,7 @@
|
||||
|
||||
(def ^:private schema:create-team
|
||||
[:map {:title "create-team"}
|
||||
[:name [:string {:max 250}]]
|
||||
[:name :string]
|
||||
[:features {:optional true} ::cfeat/features]
|
||||
[:id {:optional true} ::sm/uuid]])
|
||||
|
||||
@@ -357,12 +363,10 @@
|
||||
::quotes/profile-id profile-id})
|
||||
|
||||
(let [features (-> (cfeat/get-enabled-features cf/flags)
|
||||
(cfeat/check-client-features! (:features params)))
|
||||
team (create-team cfg (assoc params
|
||||
:profile-id profile-id
|
||||
:features features))]
|
||||
(with-meta team
|
||||
{::audit/props {:id (:id team)}})))))
|
||||
(cfeat/check-client-features! (:features params)))]
|
||||
(create-team cfg (assoc params
|
||||
:profile-id profile-id
|
||||
:features features))))))
|
||||
|
||||
(defn create-team
|
||||
"This is a complete team creation process, it creates the team
|
||||
@@ -433,14 +437,12 @@
|
||||
|
||||
;; --- Mutation: Update Team
|
||||
|
||||
(def ^:private schema:update-team
|
||||
[:map {:title "update-team"}
|
||||
[:name [:string {:max 250}]]
|
||||
[:id ::sm/uuid]])
|
||||
(s/def ::update-team
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::name ::id]))
|
||||
|
||||
(sv/defmethod ::update-team
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:update-team}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(check-edition-permissions! conn profile-id id)
|
||||
@@ -500,49 +502,30 @@
|
||||
|
||||
nil))
|
||||
|
||||
(def ^:private schema:leave-team
|
||||
[:map {:title "leave-team"}
|
||||
[:id ::sm/uuid]
|
||||
[:reassign-to {:optional true} ::sm/uuid]])
|
||||
(s/def ::reassign-to ::us/uuid)
|
||||
(s/def ::leave-team
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::id]
|
||||
:opt-un [::reassign-to]))
|
||||
|
||||
(sv/defmethod ::leave-team
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:leave-team}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(leave-team conn (assoc params :profile-id profile-id))))
|
||||
|
||||
;; --- Mutation: Delete Team
|
||||
|
||||
(defn- delete-team
|
||||
"Mark a team for deletion"
|
||||
[conn team-id]
|
||||
(s/def ::delete-team
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::id]))
|
||||
|
||||
(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
|
||||
:code :non-deletable-team
|
||||
:hint "impossible to delete default team"))
|
||||
|
||||
(wrk/submit! {::db/conn conn
|
||||
::wrk/task :delete-object
|
||||
::wrk/params {:object :team
|
||||
:deleted-at deleted-at
|
||||
:id team-id}})
|
||||
team))
|
||||
|
||||
(def ^:private schema:delete-team
|
||||
[:map {:title "delete-team"}
|
||||
[:id ::sm/uuid]])
|
||||
;; TODO: right now just don't allow delete default team, in future it
|
||||
;; should raise a specific exception for signal that this action is
|
||||
;; not allowed.
|
||||
|
||||
(sv/defmethod ::delete-team
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:delete-team}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [perms (get-permissions conn profile-id id)]
|
||||
@@ -550,11 +533,18 @@
|
||||
(ex/raise :type :validation
|
||||
:code :only-owner-can-delete-team))
|
||||
|
||||
(delete-team conn id)
|
||||
(db/update! conn :team
|
||||
{:deleted-at (dt/now)}
|
||||
{:id id :is-default false})
|
||||
nil)))
|
||||
|
||||
|
||||
;; --- Mutation: Team Update Role
|
||||
|
||||
(s/def ::team-id ::us/uuid)
|
||||
(s/def ::member-id ::us/uuid)
|
||||
(s/def ::role #{:owner :admin :editor})
|
||||
|
||||
;; Temporarily disabled viewer role
|
||||
;; https://tree.taiga.io/project/penpot/issue/1083
|
||||
(def valid-roles
|
||||
@@ -618,29 +608,25 @@
|
||||
:profile-id member-id})
|
||||
nil)))
|
||||
|
||||
(def ^:private schema:update-team-member-role
|
||||
[:map {:title "update-team-member-role"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:member-id ::sm/uuid]
|
||||
[:role schema:role]])
|
||||
(s/def ::update-team-member-role
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::member-id ::role]))
|
||||
|
||||
(sv/defmethod ::update-team-member-role
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:update-team-member-role}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(update-team-member-role conn (assoc params :profile-id profile-id))))
|
||||
|
||||
|
||||
;; --- Mutation: Delete Team Member
|
||||
|
||||
(def ^:private schema:delete-team-member
|
||||
[:map {:title "delete-team-member"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:member-id ::sm/uuid]])
|
||||
(s/def ::delete-team-member
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::member-id]))
|
||||
|
||||
(sv/defmethod ::delete-team-member
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:delete-team-member}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [perms (get-permissions conn profile-id team-id)]
|
||||
@@ -663,14 +649,13 @@
|
||||
(declare upload-photo)
|
||||
(declare ^:private update-team-photo)
|
||||
|
||||
(def ^:private schema:update-team-photo
|
||||
[:map {:title "update-team-photo"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:file ::media/upload]])
|
||||
(s/def ::file ::media/upload)
|
||||
(s/def ::update-team-photo
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::file]))
|
||||
|
||||
(sv/defmethod ::update-team-photo
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:update-team-photo}
|
||||
{::doc/added "1.17"}
|
||||
[cfg {:keys [::rpc/profile-id file] :as params}]
|
||||
;; Validate incoming mime type
|
||||
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
|
||||
@@ -765,7 +750,6 @@
|
||||
{:id (:id member)}))
|
||||
|
||||
nil)
|
||||
|
||||
(let [id (uuid/next)
|
||||
expire (dt/in-future "168h") ;; 7 days
|
||||
invitation (db/exec-one! conn [sql:upsert-team-invitation id
|
||||
@@ -786,19 +770,14 @@
|
||||
(when (contains? cf/flags :log-invitation-tokens)
|
||||
(l/info :hint "invitation token" :token itoken))
|
||||
|
||||
|
||||
(let [props (-> (dissoc tprops :profile-id)
|
||||
(audit/clean-props))
|
||||
context (audit/params->context params)]
|
||||
|
||||
(audit/submit! cfg
|
||||
{::audit/type "action"
|
||||
::audit/name (if updated?
|
||||
"update-team-invitation"
|
||||
"create-team-invitation")
|
||||
::audit/profile-id (:id profile)
|
||||
::audit/props props
|
||||
::audit/context context}))
|
||||
(audit/submit! cfg
|
||||
{::audit/type "action"
|
||||
::audit/name (if updated?
|
||||
"update-team-invitation"
|
||||
"create-team-invitation")
|
||||
::audit/profile-id (:id profile)
|
||||
::audit/props (-> (dissoc tprops :profile-id)
|
||||
(d/without-nils))})
|
||||
|
||||
(eml/send! {::eml/conn conn
|
||||
::eml/factory eml/invite-to-team
|
||||
@@ -814,7 +793,7 @@
|
||||
(def ^:private schema:create-team-invitations
|
||||
[:map {:title "create-team-invitations"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:role schema:role]
|
||||
[:role [::sm/one-of #{:owner :admin :editor}]]
|
||||
[:emails ::sm/set-of-emails]])
|
||||
|
||||
(sv/defmethod ::create-team-invitations
|
||||
@@ -858,19 +837,25 @@
|
||||
;; We don't re-send inviation to already existing members
|
||||
(remove (partial contains? members))
|
||||
(map (fn [email]
|
||||
(-> params
|
||||
(assoc :email email)
|
||||
(assoc :team team)
|
||||
(assoc :profile profile)
|
||||
(assoc :role role))))
|
||||
{:email email
|
||||
:team team
|
||||
:profile profile
|
||||
:role role}))
|
||||
(keep (partial create-invitation cfg)))
|
||||
emails)]
|
||||
(with-meta {:total (count invitations)
|
||||
:invitations invitations}
|
||||
{::audit/props {:invitations (count invitations)}})))))
|
||||
|
||||
|
||||
;; --- Mutation: Create Team & Invite Members
|
||||
|
||||
(s/def ::emails ::us/set-of-valid-emails)
|
||||
(s/def ::create-team-with-invitations
|
||||
(s/merge ::create-team
|
||||
(s/keys :req-un [::emails ::role])))
|
||||
|
||||
|
||||
(def ^:private schema:create-team-with-invitations
|
||||
[:map {:title "create-team-with-invitations"}
|
||||
[:name :string]
|
||||
@@ -882,30 +867,26 @@
|
||||
(sv/defmethod ::create-team-with-invitations
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:create-team-with-invitations}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role name] :as params}]
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
|
||||
(let [features (-> (cfeat/get-enabled-features cf/flags)
|
||||
(cfeat/check-client-features! (:features params)))
|
||||
|
||||
params (-> params
|
||||
(assoc :profile-id profile-id)
|
||||
(assoc :features features))
|
||||
|
||||
params (assoc params
|
||||
:profile-id profile-id
|
||||
:features features)
|
||||
cfg (assoc cfg ::db/conn conn)
|
||||
team (create-team cfg params)
|
||||
profile (db/get-by-id conn :profile profile-id)
|
||||
emails (into #{} (map profile/clean-email) emails)
|
||||
context (audit/params->context params)]
|
||||
emails (into #{} (map profile/clean-email) emails)]
|
||||
|
||||
;; Create invitations for all provided emails.
|
||||
(->> emails
|
||||
(map (fn [email]
|
||||
(-> params
|
||||
(assoc :team team)
|
||||
(assoc :profile profile)
|
||||
(assoc :email email)
|
||||
(assoc :role role))))
|
||||
{:team team
|
||||
:profile profile
|
||||
:email email
|
||||
:role role}))
|
||||
(run! (partial create-invitation cfg)))
|
||||
|
||||
(run! (partial quotes/check-quote! conn)
|
||||
@@ -920,14 +901,6 @@
|
||||
::quotes/team-id (:id team)
|
||||
::quotes/incr (count emails)}))
|
||||
|
||||
(audit/submit! cfg
|
||||
{::audit/type "action"
|
||||
::audit/name "create-team"
|
||||
::audit/profile-id profile-id
|
||||
::audit/props {:name name
|
||||
:features features}
|
||||
::audit/context context})
|
||||
|
||||
(audit/submit! cfg
|
||||
{::audit/type "command"
|
||||
::audit/name "create-team-invitations"
|
||||
@@ -941,14 +914,12 @@
|
||||
|
||||
;; --- Query: get-team-invitation-token
|
||||
|
||||
(def ^:private schema:get-team-invitation-token
|
||||
[:map {:title "get-team-invitation-token"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:email ::sm/email]])
|
||||
(s/def ::get-team-invitation-token
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::email]))
|
||||
|
||||
(sv/defmethod ::get-team-invitation-token
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:get-team-invitation-token}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
|
||||
(check-read-permissions! pool profile-id team-id)
|
||||
(let [email (profile/clean-email email)
|
||||
@@ -969,15 +940,12 @@
|
||||
|
||||
;; --- Mutation: Update invitation role
|
||||
|
||||
(def ^:private schema:update-team-invitation-role
|
||||
[:map {:title "update-team-invitation-role"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:email ::sm/email]
|
||||
[:role schema:role]])
|
||||
(s/def ::update-team-invitation-role
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::email ::role]))
|
||||
|
||||
(sv/defmethod ::update-team-invitation-role
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:update-team-invitation-role}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [perms (get-permissions conn profile-id team-id)]
|
||||
@@ -993,14 +961,12 @@
|
||||
|
||||
;; --- Mutation: Delete invitation
|
||||
|
||||
(def ^:private schema:delete-team-invition
|
||||
[:map {:title "delete-team-invitation"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:email ::sm/email]])
|
||||
(s/def ::delete-team-invitation
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::email]))
|
||||
|
||||
(sv/defmethod ::delete-team-invitation
|
||||
{::doc/added "1.17"
|
||||
::sm/params schema:delete-team-invition}
|
||||
{::doc/added "1.17"}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [perms (get-permissions conn profile-id team-id)]
|
||||
|
||||
@@ -147,7 +147,7 @@
|
||||
|
||||
(defmethod process-token :team-invitation
|
||||
[{:keys [conn] :as cfg}
|
||||
{:keys [::rpc/profile-id token] :as params}
|
||||
{:keys [::rpc/profile-id token]}
|
||||
{:keys [member-id team-id member-email] :as claims}]
|
||||
|
||||
(us/verify! ::team-invitation-claims claims)
|
||||
@@ -169,20 +169,13 @@
|
||||
;; if we have logged-in user and it matches the invitation we proceed
|
||||
;; with accepting the invitation and joining the current profile to the
|
||||
;; invited team.
|
||||
(let [context (audit/params->context params)
|
||||
props {:team-id (:team-id claims)
|
||||
:role (:role claims)
|
||||
:invitation-id (:id invitation)}]
|
||||
|
||||
(accept-invitation cfg claims invitation profile)
|
||||
(audit/submit! cfg
|
||||
{::audit/type "action"
|
||||
::audit/name "accept-team-invitation"
|
||||
::audit/profile-id profile-id
|
||||
::audit/props props
|
||||
::audit/context context})
|
||||
|
||||
(assoc claims :state :created))
|
||||
(let [profile (accept-invitation cfg claims invitation profile)]
|
||||
(-> (assoc claims :state :created)
|
||||
(rph/with-meta {::audit/name "accept-team-invitation"
|
||||
::audit/profile-id (:id profile)
|
||||
::audit/props {:team-id (:team-id claims)
|
||||
:role (:role claims)
|
||||
:invitation-id (:id invitation)}})))
|
||||
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-token
|
||||
|
||||
@@ -83,17 +83,17 @@
|
||||
"- Quote ID: '~(::target params)'\n"
|
||||
"- Max: ~(::quote params)\n"
|
||||
"- Total: ~(::total params) (INCR ~(::incr params 1))\n")]
|
||||
(wrk/submit! {::db/conn conn
|
||||
::wrk/task :sendmail
|
||||
(wrk/submit! {::wrk/task :sendmail
|
||||
::wrk/delay (dt/duration "30s")
|
||||
::wrk/max-retries 4
|
||||
::wrk/priority 200
|
||||
::wrk/conn conn
|
||||
::wrk/dedupe true
|
||||
::wrk/label "quotes-notification"
|
||||
::wrk/params {:to (vec admins)
|
||||
:subject subject
|
||||
:body [{:type "text/plain"
|
||||
:content content}]}}))))
|
||||
:to (vec admins)
|
||||
:subject subject
|
||||
:body [{:type "text/plain"
|
||||
:content content}]}))))
|
||||
|
||||
(defn- generic-check!
|
||||
[{:keys [::db/conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]
|
||||
|
||||
@@ -12,7 +12,6 @@
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
[app.rpc.commands.auth :as cmd.auth]
|
||||
[app.rpc.commands.profile :as cmd.profile]
|
||||
[app.util.json :as json]
|
||||
[app.util.time :as dt]
|
||||
[cuerdas.core :as str]))
|
||||
@@ -38,13 +37,12 @@
|
||||
:or {is-active true}}]
|
||||
(when-let [system (get-current-system)]
|
||||
(db/with-atomic [conn (:app.db/pool system)]
|
||||
(let [password (cmd.profile/derive-password system password)
|
||||
params {:id (uuid/next)
|
||||
:email email
|
||||
:fullname fullname
|
||||
:is-active is-active
|
||||
:password password
|
||||
:props {}}]
|
||||
(let [params {:id (uuid/next)
|
||||
:email email
|
||||
:fullname fullname
|
||||
:is-active is-active
|
||||
:password password
|
||||
:props {}}]
|
||||
(->> (cmd.auth/create-profile! conn params)
|
||||
(cmd.auth/create-profile-rels! conn))))))
|
||||
|
||||
|
||||
@@ -184,7 +184,10 @@
|
||||
(ctk/instance-head? child))
|
||||
(let [slot (guess-swap-slot component-child component-container)]
|
||||
(l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot)
|
||||
(ctn/update-shape container (:id child) #(ctk/set-swap-slot % slot)))
|
||||
(ctn/update-shape container (:id child)
|
||||
#(update % :touched
|
||||
cfh/set-touched-group
|
||||
(ctk/build-swap-slot-group slot))))
|
||||
container)]
|
||||
(recur (process-copy-head container child)
|
||||
(rest children)
|
||||
@@ -234,44 +237,3 @@
|
||||
|
||||
file (-> file
|
||||
(update :data process-fdata))))
|
||||
|
||||
|
||||
|
||||
(defn fix-find-duplicated-slots
|
||||
[file _]
|
||||
;; Find the shapes whose children have duplicated slots
|
||||
(let [check-duplicate-swap-slot
|
||||
(fn [shape page]
|
||||
(let [shapes (map #(get (:objects page) %) (:shapes shape))
|
||||
slots (->> (map #(ctk/get-swap-slot %) shapes)
|
||||
(remove nil?))
|
||||
counts (frequencies slots)]
|
||||
#_(when (some (fn [[_ count]] (> count 1)) counts)
|
||||
(l/trc :info "This shape has children with the same swap slot" :id (:id shape) :file-id (str (:id file))))
|
||||
(some (fn [[_ count]] (> count 1)) counts)))
|
||||
|
||||
count-slots-shape
|
||||
(fn [page shape]
|
||||
(if (ctk/instance-root? shape)
|
||||
(check-duplicate-swap-slot shape page)
|
||||
false))
|
||||
|
||||
count-slots-page
|
||||
(fn [page]
|
||||
(->> (:objects page)
|
||||
(vals)
|
||||
(mapv #(count-slots-shape page %))
|
||||
(filter true?)
|
||||
count))
|
||||
|
||||
count-slots-data
|
||||
(fn [data]
|
||||
(->> (:pages-index data)
|
||||
(vals)
|
||||
(mapv count-slots-page)
|
||||
(reduce +)))
|
||||
|
||||
num-missing-slots (count-slots-data (:data file))]
|
||||
(when (pos? num-missing-slots)
|
||||
(l/trc :info (str "Shapes with children with the same swap slot: " num-missing-slots) :file-id (str (:id file))))
|
||||
file))
|
||||
|
||||
@@ -30,8 +30,6 @@
|
||||
[app.rpc.commands.files-snapshot :as fsnap]
|
||||
[app.rpc.commands.management :as mgmt]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.rpc.commands.projects :as projects]
|
||||
[app.rpc.commands.teams :as teams]
|
||||
[app.srepl.fixes :as fixes]
|
||||
[app.srepl.helpers :as h]
|
||||
[app.util.blob :as blob]
|
||||
@@ -59,27 +57,32 @@
|
||||
([tname]
|
||||
(run-task! tname {}))
|
||||
([tname params]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task tname)
|
||||
(assoc ::wrk/params params)))))
|
||||
(let [tasks (:app.worker/registry main/system)
|
||||
tname (if (keyword? tname) (name tname) name)]
|
||||
(if-let [task-fn (get tasks tname)]
|
||||
(task-fn params)
|
||||
(println (format "no task '%s' found" tname))))))
|
||||
|
||||
(defn schedule-task!
|
||||
([name]
|
||||
(schedule-task! name {}))
|
||||
([name params]
|
||||
(wrk/submit! (-> main/system
|
||||
(assoc ::wrk/task name)
|
||||
(assoc ::wrk/params params)))))
|
||||
([name props]
|
||||
(let [pool (:app.db/pool main/system)]
|
||||
(wrk/submit!
|
||||
::wrk/conn pool
|
||||
::wrk/task name
|
||||
::wrk/props props))))
|
||||
|
||||
(defn send-test-email!
|
||||
[destination]
|
||||
(assert (string? destination) "destination should be provided")
|
||||
(-> main/system
|
||||
(assoc ::wrk/task :sendmail)
|
||||
(assoc ::wrk/params {:body "test email"
|
||||
:subject "test email"
|
||||
:to [destination]})
|
||||
(wrk/invoke!)))
|
||||
(us/verify!
|
||||
:expr (string? destination)
|
||||
:hint "destination should be provided")
|
||||
|
||||
(let [handler (:app.email/sendmail main/system)]
|
||||
(handler {:body "test email"
|
||||
:subject "test email"
|
||||
:to [destination]})))
|
||||
|
||||
(defn resend-email-verification-email!
|
||||
[email]
|
||||
@@ -189,6 +192,7 @@
|
||||
;; NOTIFICATIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defn notify!
|
||||
[{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
|
||||
:or {code :generic level :info}
|
||||
@@ -470,183 +474,6 @@
|
||||
:rollback rollback?
|
||||
:elapsed elapsed))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- restore-file*
|
||||
[{:keys [::db/conn]} file-id]
|
||||
(db/update! conn :file
|
||||
{:deleted-at nil
|
||||
:has-media-trimmed false}
|
||||
{:id file-id})
|
||||
|
||||
;; Fragments are not handled here because they
|
||||
;; use the database cascade operation and they
|
||||
;; are not marked for deletion with objects-gc
|
||||
;; task
|
||||
|
||||
(db/update! conn :file-media-object
|
||||
{:deleted-at nil}
|
||||
{:file-id file-id})
|
||||
|
||||
;; Mark thumbnails to be deleted
|
||||
(db/update! conn :file-thumbnail
|
||||
{:deleted-at nil}
|
||||
{:file-id file-id})
|
||||
|
||||
(db/update! conn :file-tagged-object-thumbnail
|
||||
{:deleted-at nil}
|
||||
{:file-id file-id})
|
||||
|
||||
:restored)
|
||||
|
||||
(defn- restore-project*
|
||||
[{:keys [::db/conn] :as cfg} project-id]
|
||||
|
||||
(db/update! conn :project
|
||||
{:deleted-at nil}
|
||||
{:id project-id})
|
||||
|
||||
(doseq [{:keys [id]} (db/query conn :file
|
||||
{:project-id project-id}
|
||||
{::db/columns [:id]})]
|
||||
(restore-file* cfg id))
|
||||
|
||||
:restored)
|
||||
|
||||
(defn- restore-team*
|
||||
[{:keys [::db/conn] :as cfg} team-id]
|
||||
(db/update! conn :team
|
||||
{:deleted-at nil}
|
||||
{:id team-id})
|
||||
|
||||
(db/update! conn :team-font-variant
|
||||
{:deleted-at nil}
|
||||
{:team-id team-id})
|
||||
|
||||
(doseq [{:keys [id]} (db/query conn :project
|
||||
{:team-id team-id}
|
||||
{::db/columns [:id]})]
|
||||
(restore-project* cfg id))
|
||||
|
||||
:restored)
|
||||
|
||||
(defn- restore-profile*
|
||||
[{:keys [::db/conn] :as cfg} profile-id]
|
||||
(db/update! conn :profile
|
||||
{:deleted-at nil}
|
||||
{:id profile-id})
|
||||
|
||||
(doseq [{:keys [id]} (profile/get-owned-teams conn profile-id)]
|
||||
(restore-team* cfg id))
|
||||
|
||||
:restored)
|
||||
|
||||
|
||||
(defn restore-deleted-profile!
|
||||
"Mark a team and all related objects as not deleted"
|
||||
[profile-id]
|
||||
(let [profile-id (h/parse-uuid profile-id)]
|
||||
(db/tx-run! main/system restore-profile* profile-id)))
|
||||
|
||||
(defn restore-deleted-team!
|
||||
"Mark a team and all related objects as not deleted"
|
||||
[team-id]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(db/tx-run! main/system restore-team* team-id)))
|
||||
|
||||
(defn restore-deleted-project!
|
||||
"Mark a project and all related objects as not deleted"
|
||||
[project-id]
|
||||
(let [project-id (h/parse-uuid project-id)]
|
||||
(db/tx-run! main/system restore-project* project-id)))
|
||||
|
||||
(defn restore-deleted-file!
|
||||
"Mark a file and all related objects as not deleted"
|
||||
[file-id]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! main/system restore-file* file-id)))
|
||||
|
||||
(defn delete-team!
|
||||
"Mark a team for deletion"
|
||||
[team-id]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :team
|
||||
:deleted-at (dt/now)
|
||||
:id team-id})))))
|
||||
(defn delete-profile!
|
||||
"Mark a profile for deletion"
|
||||
[profile-id]
|
||||
(let [profile-id (h/parse-uuid profile-id)]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :profile
|
||||
:deleted-at (dt/now)
|
||||
:id profile-id})))))
|
||||
(defn delete-project!
|
||||
"Mark a project for deletion"
|
||||
[project-id]
|
||||
(let [project-id (h/parse-uuid project-id)]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :project
|
||||
:deleted-at (dt/now)
|
||||
:id project-id})))))
|
||||
|
||||
(defn delete-file!
|
||||
"Mark a project for deletion"
|
||||
[file-id]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :file
|
||||
:deleted-at (dt/now)
|
||||
:id file-id})))))
|
||||
|
||||
(defn process-deleted-profiles-cascade
|
||||
[]
|
||||
(->> (db/exec! main/system ["select id, deleted_at from profile where deleted_at is not null"])
|
||||
(run! (fn [{:keys [id deleted-at]}]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :profile
|
||||
:deleted-at deleted-at
|
||||
:id id})))))))
|
||||
|
||||
(defn process-deleted-teams-cascade
|
||||
[]
|
||||
(->> (db/exec! main/system ["select id, deleted_at from team where deleted_at is not null"])
|
||||
(run! (fn [{:keys [id deleted-at]}]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :team
|
||||
:deleted-at deleted-at
|
||||
:id id})))))))
|
||||
|
||||
(defn process-deleted-projects-cascade
|
||||
[]
|
||||
(->> (db/exec! main/system ["select id, deleted_at from project where deleted_at is not null"])
|
||||
(run! (fn [{:keys [id deleted-at]}]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :project
|
||||
:deleted-at deleted-at
|
||||
:id id})))))))
|
||||
|
||||
(defn process-deleted-files-cascade
|
||||
[]
|
||||
(->> (db/exec! main/system ["select id, deleted_at from file where deleted_at is not null"])
|
||||
(run! (fn [{:keys [id deleted-at]}]
|
||||
(wrk/invoke! (-> main/system
|
||||
(assoc ::wrk/task :delete-object)
|
||||
(assoc ::wrk/params {:object :file
|
||||
:deleted-at deleted-at
|
||||
:id id})))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MISC
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@@ -16,6 +16,7 @@
|
||||
[app.storage.impl :as impl]
|
||||
[app.storage.s3 :as ss3]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[datoteka.fs :as fs]
|
||||
[integrant.core :as ig]
|
||||
@@ -170,16 +171,28 @@
|
||||
(impl/put-object object content))
|
||||
object)))
|
||||
|
||||
(def ^:private default-touch-delay
|
||||
"A default delay for the asynchronous touch operation"
|
||||
(dt/duration "5m"))
|
||||
|
||||
(defn touch-object!
|
||||
"Mark object as touched."
|
||||
[{:keys [::db/pool-or-conn] :as storage} object-or-id]
|
||||
[{:keys [::db/pool-or-conn] :as storage} object-or-id & {:keys [async]}]
|
||||
(us/assert! ::storage storage)
|
||||
(let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)]
|
||||
(-> (db/update! pool-or-conn :storage-object
|
||||
{:touched-at (dt/now)}
|
||||
{:id id})
|
||||
(db/get-update-count)
|
||||
(pos?))))
|
||||
(if async
|
||||
(wrk/submit! ::wrk/conn pool-or-conn
|
||||
::wrk/task :object-update
|
||||
::wrk/delay default-touch-delay
|
||||
:object :storage-object
|
||||
:id id
|
||||
:key :touched-at
|
||||
:val (dt/now))
|
||||
(-> (db/update! pool-or-conn :storage-object
|
||||
{:touched-at (dt/now)}
|
||||
{:id id})
|
||||
(db/get-update-count)
|
||||
(pos?)))))
|
||||
|
||||
(defn get-object-data
|
||||
"Return an input stream instance of the object content."
|
||||
|
||||
@@ -110,8 +110,8 @@
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::min-age] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [min-age (dt/duration (or (:min-age props) min-age))]
|
||||
(fn [params]
|
||||
(let [min-age (dt/duration (or (:min-age params) min-age))]
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(let [cfg (assoc cfg ::min-age min-age)
|
||||
total (clean-deleted! cfg)]
|
||||
|
||||
@@ -1,122 +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.tasks.delete-object
|
||||
"A generic task for object deletion cascade handling"
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.db :as db]
|
||||
[app.rpc.commands.files :as files]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(def ^:dynamic *team-deletion* false)
|
||||
|
||||
(defmulti delete-object
|
||||
(fn [_ props] (:object props)))
|
||||
|
||||
(defmethod delete-object :file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
|
||||
(when-let [file (db/get* conn :file {:id id} {::db/remove-deleted false})]
|
||||
(l/trc :hint "marking for deletion" :rel "file" :id (str id)
|
||||
:deleted-at (dt/format-instant deleted-at))
|
||||
|
||||
(db/update! conn :file
|
||||
{:deleted-at deleted-at}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(when (and (:is-shared file)
|
||||
(not *team-deletion*))
|
||||
;; NOTE: we don't prevent file deletion on absorb operation failure
|
||||
(try
|
||||
(db/tx-run! cfg files/absorb-library! id)
|
||||
(catch Throwable cause
|
||||
(l/warn :hint "error on absorbing library"
|
||||
:file-id id
|
||||
:cause cause))))
|
||||
|
||||
;; Mark file media objects to be deleted
|
||||
(db/update! conn :file-media-object
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})
|
||||
|
||||
;; Mark thumbnails to be deleted
|
||||
(db/update! conn :file-thumbnail
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})
|
||||
|
||||
(db/update! conn :file-tagged-object-thumbnail
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})))
|
||||
|
||||
(defmethod delete-object :project
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
|
||||
(l/trc :hint "marking for deletion" :rel "project" :id (str id)
|
||||
:deleted-at (dt/format-instant deleted-at))
|
||||
|
||||
(db/update! conn :project
|
||||
{:deleted-at deleted-at}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(doseq [file (db/query conn :file
|
||||
{:project-id id}
|
||||
{::db/columns [:id :deleted-at]})]
|
||||
(delete-object cfg (assoc file
|
||||
:object :file
|
||||
:deleted-at deleted-at))))
|
||||
|
||||
(defmethod delete-object :team
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
|
||||
(l/trc :hint "marking for deletion" :rel "team" :id (str id)
|
||||
:deleted-at (dt/format-instant deleted-at))
|
||||
(db/update! conn :team
|
||||
{:deleted-at deleted-at}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(db/update! conn :team-font-variant
|
||||
{:deleted-at deleted-at}
|
||||
{:team-id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(binding [*team-deletion* true]
|
||||
(doseq [project (db/query conn :project
|
||||
{:team-id id}
|
||||
{::db/columns [:id :deleted-at]})]
|
||||
(delete-object cfg (assoc project
|
||||
:object :project
|
||||
:deleted-at deleted-at)))))
|
||||
|
||||
(defmethod delete-object :profile
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
|
||||
(l/trc :hint "marking for deletion" :rel "profile" :id (str id)
|
||||
:deleted-at (dt/format-instant deleted-at))
|
||||
|
||||
(db/update! conn :profile
|
||||
{:deleted-at deleted-at}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(doseq [team (profile/get-owned-teams conn id)]
|
||||
(delete-object cfg (assoc team
|
||||
:object :team
|
||||
:deleted-at deleted-at))))
|
||||
|
||||
(defmethod delete-object :default
|
||||
[_cfg props]
|
||||
(l/wrn :hint "not implementation found" :rel (:object props)))
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(db/tx-run! cfg delete-object props)))
|
||||
@@ -299,13 +299,13 @@
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(fn [{:keys [file-id] :as params}]
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
|
||||
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
|
||||
cfg (-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage conn)
|
||||
(assoc ::file-id (:file-id props))
|
||||
(assoc ::file-id file-id)
|
||||
(assoc ::min-age min-age))
|
||||
|
||||
total (reduce (fn [total file]
|
||||
@@ -319,7 +319,7 @@
|
||||
:processed total)
|
||||
|
||||
;; Allow optional rollback passed by params
|
||||
(when (:rollback? props)
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
{:processed total})))))
|
||||
|
||||
@@ -29,8 +29,8 @@
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::db/pool] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [min-age (or (:min-age props) (::min-age cfg))]
|
||||
(fn [params]
|
||||
(let [min-age (or (:min-age params) (::min-age cfg))]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval min-age)
|
||||
result (db/exec-one! conn [sql:delete-files-xlog interval])
|
||||
@@ -38,7 +38,7 @@
|
||||
|
||||
(l/info :hint "task finished" :min-age (dt/format-duration min-age) :total result)
|
||||
|
||||
(when (:rollback? props)
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
result)))))
|
||||
|
||||
32
backend/src/app/tasks/object_update.clj
Normal file
32
backend/src/app/tasks/object_update.clj
Normal file
@@ -0,0 +1,32 @@
|
||||
;; 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.tasks.object-update
|
||||
"A task used for perform simple object properties update
|
||||
in an asynchronous flow."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.logging :as l]
|
||||
[app.db :as db]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(defn- update-object
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id object key val] :as props}]
|
||||
(l/trc :hint "update object prop"
|
||||
:id (str id)
|
||||
:object (d/name object)
|
||||
:key (d/name key)
|
||||
:val val)
|
||||
(db/update! conn object {key val} {:id id} {::db/return-keys false}))
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as params}]
|
||||
(db/tx-run! cfg update-object props)))
|
||||
@@ -17,24 +17,78 @@
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare ^:private delete-file-data-fragments!)
|
||||
(declare ^:private delete-file-media-objects!)
|
||||
(declare ^:private delete-file-object-thumbnails!)
|
||||
(declare ^:private delete-file-thumbnails!)
|
||||
(declare ^:private delete-files!)
|
||||
(declare ^:private delete-fonts!)
|
||||
(declare ^:private delete-profiles!)
|
||||
(declare ^:private delete-projects!)
|
||||
(declare ^:private delete-teams!)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req [::db/pool ::sto/storage]))
|
||||
|
||||
(defmethod ig/prep-key ::handler
|
||||
[_ cfg]
|
||||
(assoc cfg ::min-age cf/deletion-delay))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [params]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
;; Disable deletion protection for the current transaction
|
||||
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
||||
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
||||
|
||||
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
|
||||
cfg (-> cfg
|
||||
(assoc ::min-age (db/interval min-age))
|
||||
(update ::sto/storage media/configure-assets-storage conn))
|
||||
|
||||
total (reduce + 0
|
||||
[(delete-profiles! cfg)
|
||||
(delete-teams! cfg)
|
||||
(delete-fonts! cfg)
|
||||
(delete-projects! cfg)
|
||||
(delete-files! cfg)
|
||||
(delete-file-thumbnails! cfg)
|
||||
(delete-file-object-thumbnails! cfg)
|
||||
(delete-file-data-fragments! cfg)
|
||||
(delete-file-media-objects! cfg)])]
|
||||
|
||||
(l/info :hint "task finished"
|
||||
:deleted total
|
||||
:rollback? (boolean (:rollback? params)))
|
||||
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
{:processed total})))))
|
||||
|
||||
(def ^:private sql:get-profiles
|
||||
"SELECT id, photo_id FROM profile
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-profiles!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-profiles min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-profiles min-age])
|
||||
(reduce (fn [total {:keys [id photo-id]}]
|
||||
(l/trc :hint "permanently delete" :rel "profile" :id (str id))
|
||||
|
||||
;; Mark as deleted the storage object
|
||||
(some->> photo-id (sto/touch-object! storage))
|
||||
|
||||
;; And finally, permanently delete the profile. The
|
||||
;; relevant objects will be deleted using DELETE
|
||||
;; CASCADE database triggers. This may leave orphan
|
||||
;; teams, but there is a special task for deleting
|
||||
;; orphaned teams.
|
||||
(db/delete! conn :profile {:id id})
|
||||
|
||||
(inc total))
|
||||
@@ -45,13 +99,13 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-teams!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-teams min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
|
||||
(->> (db/cursor conn [sql:get-teams min-age])
|
||||
(reduce (fn [total {:keys [id photo-id deleted-at]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "team"
|
||||
@@ -64,6 +118,15 @@
|
||||
;; And finally, permanently delete the team.
|
||||
(db/delete! conn :team {:id id})
|
||||
|
||||
;; Mark for deletion in cascade
|
||||
(db/update! conn :team-font-variant
|
||||
{:deleted-at deleted-at}
|
||||
{:team-id id})
|
||||
|
||||
(db/update! conn :project
|
||||
{:deleted-at deleted-at}
|
||||
{:team-id id})
|
||||
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
@@ -73,13 +136,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-fonts!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-fonts min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-fonts min-age])
|
||||
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "team-font-variant"
|
||||
@@ -105,13 +167,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-projects!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-projects min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-projects min-age])
|
||||
(reduce (fn [total {:keys [id team-id deleted-at]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "project"
|
||||
@@ -122,6 +183,11 @@
|
||||
;; And finally, permanently delete the project.
|
||||
(db/delete! conn :project {:id id})
|
||||
|
||||
;; Mark files to be deleted
|
||||
(db/update! conn :file
|
||||
{:deleted-at deleted-at}
|
||||
{:project-id id})
|
||||
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
@@ -131,13 +197,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-files!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-files min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-files min-age])
|
||||
(reduce (fn [total {:keys [id deleted-at project-id]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "file"
|
||||
@@ -145,9 +210,26 @@
|
||||
:project-id (str project-id)
|
||||
:deleted-at (dt/format-instant deleted-at))
|
||||
|
||||
;; NOTE: fragments not handled here because they have
|
||||
;; cascade.
|
||||
|
||||
;; And finally, permanently delete the file.
|
||||
(db/delete! conn :file {:id id})
|
||||
|
||||
;; Mark file media objects to be deleted
|
||||
(db/update! conn :file-media-object
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})
|
||||
|
||||
;; Mark thumbnails to be deleted
|
||||
(db/update! conn :file-thumbnail
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})
|
||||
|
||||
(db/update! conn :file-tagged-object-thumbnail
|
||||
{:deleted-at deleted-at}
|
||||
{:file-id id})
|
||||
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
@@ -157,13 +239,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn delete-file-thumbnails!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-thumbnails min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-thumbnails min-age])
|
||||
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "file-thumbnail"
|
||||
@@ -186,13 +267,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn delete-file-object-thumbnails!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-object-thumbnails min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-object-thumbnails min-age])
|
||||
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "file-tagged-object-thumbnail"
|
||||
@@ -215,13 +295,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-file-data-fragments!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-data-fragments min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-data-fragments min-age])
|
||||
(reduce (fn [total {:keys [file-id id deleted-at]}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "file-data-fragment"
|
||||
@@ -240,13 +319,12 @@
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
LIMIT ?
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-file-media-objects!
|
||||
[{:keys [::db/conn ::min-age ::chunk-size ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-media-objects min-age chunk-size] {:chunk-size 1})
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-file-media-objects min-age])
|
||||
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
|
||||
(l/trc :hint "permanently delete"
|
||||
:rel "file-media-object"
|
||||
@@ -262,53 +340,3 @@
|
||||
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
(def ^:private deletion-proc-vars
|
||||
[#'delete-profiles!
|
||||
#'delete-file-media-objects!
|
||||
#'delete-file-data-fragments!
|
||||
#'delete-file-object-thumbnails!
|
||||
#'delete-file-thumbnails!
|
||||
#'delete-files!
|
||||
#'delete-projects!
|
||||
#'delete-fonts!
|
||||
#'delete-teams!])
|
||||
|
||||
(defn- execute-proc!
|
||||
"A generic function that executes the specified proc iterativelly
|
||||
until 0 results is returned"
|
||||
[cfg proc-fn]
|
||||
(loop [total 0]
|
||||
(let [result (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
||||
(proc-fn cfg)))]
|
||||
(if (pos? result)
|
||||
(recur (+ total result))
|
||||
total))))
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req [::db/pool ::sto/storage]))
|
||||
|
||||
(defmethod ig/prep-key ::handler
|
||||
[_ cfg]
|
||||
(assoc cfg
|
||||
::min-age cf/deletion-delay
|
||||
::chunk-size 10))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
|
||||
cfg (-> cfg
|
||||
(assoc ::min-age (db/interval min-age))
|
||||
(update ::sto/storage media/configure-assets-storage))]
|
||||
|
||||
(loop [procs (map deref deletion-proc-vars)
|
||||
total 0]
|
||||
(if-let [proc-fn (first procs)]
|
||||
(let [result (execute-proc! cfg proc-fn)]
|
||||
(recur (rest procs)
|
||||
(+ total result)))
|
||||
(do
|
||||
(l/inf :hint "task finished" :deleted total)
|
||||
{:processed total}))))))
|
||||
|
||||
59
backend/src/app/tasks/orphan_teams_gc.clj
Normal file
59
backend/src/app/tasks/orphan_teams_gc.clj
Normal file
@@ -0,0 +1,59 @@
|
||||
;; 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.tasks.orphan-teams-gc
|
||||
"A maintenance task that performs orphan teams GC."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.db :as db]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare ^:private delete-orphan-teams!)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
(fn [params]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(l/inf :hint "gc started" :rollback? (boolean (:rollback? params)))
|
||||
(let [total (delete-orphan-teams! cfg)]
|
||||
(l/inf :hint "task finished"
|
||||
:teams total
|
||||
:rollback? (boolean (:rollback? params)))
|
||||
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
{:processed total})))))
|
||||
|
||||
(def ^:private sql:get-orphan-teams
|
||||
"SELECT t.id
|
||||
FROM team AS t
|
||||
LEFT JOIN team_profile_rel AS tpr
|
||||
ON (t.id = tpr.team_id)
|
||||
WHERE tpr.profile_id IS NULL
|
||||
AND t.deleted_at IS NULL
|
||||
ORDER BY t.created_at ASC
|
||||
FOR UPDATE OF t
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-orphan-teams!
|
||||
"Find all orphan teams (with no members) and mark them for
|
||||
deletion (soft delete)."
|
||||
[{:keys [::db/conn] :as cfg}]
|
||||
(->> (db/cursor conn sql:get-orphan-teams)
|
||||
(map :id)
|
||||
(reduce (fn [total team-id]
|
||||
(l/trc :hint "mark orphan team for deletion" :id (str team-id))
|
||||
(db/update! conn :team
|
||||
{:deleted-at (dt/now)}
|
||||
{:id team-id})
|
||||
(inc total))
|
||||
0)))
|
||||
@@ -27,8 +27,8 @@
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::db/pool ::min-age] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(let [min-age (or (:min-age props) min-age)]
|
||||
(fn [params]
|
||||
(let [min-age (or (:min-age params) min-age)]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval min-age)
|
||||
result (db/exec-one! conn [sql:delete-completed-tasks interval])
|
||||
@@ -36,7 +36,7 @@
|
||||
|
||||
(l/debug :hint "task finished" :total result)
|
||||
|
||||
(when (:rollback? props)
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
result)))))
|
||||
|
||||
@@ -206,16 +206,14 @@
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::db/pool ::setup/props] :as cfg}]
|
||||
(fn [task]
|
||||
(let [params (:props task)
|
||||
send? (get params :send? true)
|
||||
enabled? (or (get params :enabled? false)
|
||||
(fn [{:keys [send? enabled?] :or {send? true enabled? false}}]
|
||||
(let [subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
|
||||
:newsletter-news (get-subscriptions-newsletter-news pool)}
|
||||
|
||||
enabled? (or enabled?
|
||||
(contains? cf/flags :telemetry)
|
||||
(cf/get :telemetry-enabled))
|
||||
|
||||
subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
|
||||
:newsletter-news (get-subscriptions-newsletter-news pool)}
|
||||
|
||||
data {:subscriptions subs
|
||||
:version (:full cf/version)
|
||||
:instance-id (:instance-id props)}]
|
||||
|
||||
@@ -8,19 +8,18 @@
|
||||
"Tokens generation API."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.spec :as us]
|
||||
[app.common.transit :as t]
|
||||
[app.util.time :as dt]
|
||||
[buddy.sign.jwe :as jwe]))
|
||||
[buddy.sign.jwe :as jwe]
|
||||
[clojure.spec.alpha :as s]))
|
||||
|
||||
(s/def ::tokens-key bytes?)
|
||||
|
||||
(defn generate
|
||||
[{:keys [tokens-key]} claims]
|
||||
|
||||
(dm/assert!
|
||||
"expexted token-key to be bytes instance"
|
||||
(bytes? tokens-key))
|
||||
|
||||
(us/assert! ::tokens-key tokens-key)
|
||||
(let [payload (-> claims
|
||||
(assoc :iat (dt/now))
|
||||
(d/without-nils)
|
||||
@@ -40,13 +39,15 @@
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-token
|
||||
:reason :token-expired
|
||||
:params params))
|
||||
:params params
|
||||
:claims claims))
|
||||
(when (and (contains? params :iss)
|
||||
(not= (:iss claims)
|
||||
(:iss params)))
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-token
|
||||
:reason :invalid-issuer
|
||||
:claims claims
|
||||
:params params))
|
||||
claims))
|
||||
|
||||
|
||||
@@ -19,8 +19,7 @@
|
||||
[app.common.fressian :as fres]
|
||||
[app.common.transit :as t]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.core :as c]
|
||||
[clojure.data.json :as json])
|
||||
[clojure.core :as c])
|
||||
(:import
|
||||
clojure.lang.Counted
|
||||
clojure.lang.IHashEq
|
||||
@@ -84,10 +83,6 @@
|
||||
^:unsynchronized-mutable loaded?
|
||||
^:unsynchronized-mutable modified?]
|
||||
|
||||
json/JSONWriter
|
||||
(-write [this writter options]
|
||||
(json/-write (into {} this) writter options))
|
||||
|
||||
IHashEq
|
||||
(hasheq [this]
|
||||
(when-not hash
|
||||
|
||||
@@ -40,8 +40,7 @@
|
||||
[app.common.transit :as t]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.util.time :as dt]
|
||||
[clojure.core :as c]
|
||||
[clojure.data.json :as json])
|
||||
[clojure.core :as c])
|
||||
(:import
|
||||
clojure.lang.Counted
|
||||
clojure.lang.IDeref
|
||||
@@ -76,14 +75,6 @@
|
||||
^:unsynchronized-mutable modified?
|
||||
^:unsynchronized-mutable loaded?]
|
||||
|
||||
json/JSONWriter
|
||||
(-write [this writter options]
|
||||
(json/-write {:type "pointer"
|
||||
:id (get-id this)
|
||||
:meta (meta this)}
|
||||
writter
|
||||
options))
|
||||
|
||||
IPointerMap
|
||||
(load! [_]
|
||||
(when-not *load-fn*
|
||||
|
||||
@@ -8,7 +8,6 @@
|
||||
"Async tasks abstraction (impl)."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
@@ -59,6 +58,17 @@
|
||||
;; SUBMIT API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- extract-props
|
||||
[options]
|
||||
(let [cns (namespace ::sample)]
|
||||
(persistent!
|
||||
(reduce-kv (fn [res k v]
|
||||
(cond-> res
|
||||
(not= (namespace k) cns)
|
||||
(assoc! k v)))
|
||||
(transient {})
|
||||
options))))
|
||||
|
||||
(def ^:private sql:insert-new-task
|
||||
"insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at)
|
||||
values (?, ?, ?, ?, ?, ?, ?, now() + ?)
|
||||
@@ -77,13 +87,14 @@
|
||||
(s/def ::task (s/or :kw keyword? :str string?))
|
||||
(s/def ::queue (s/or :kw keyword? :str string?))
|
||||
(s/def ::delay (s/or :int integer? :duration dt/duration?))
|
||||
(s/def ::conn (s/or :pool ::db/pool :connection some?))
|
||||
(s/def ::priority integer?)
|
||||
(s/def ::max-retries integer?)
|
||||
(s/def ::dedupe boolean?)
|
||||
|
||||
(s/def ::submit-options
|
||||
(s/and
|
||||
(s/keys :req [::task]
|
||||
(s/keys :req [::task ::conn]
|
||||
:opt [::label ::delay ::queue ::priority ::max-retries ::dedupe])
|
||||
(fn [{:keys [::dedupe ::label] :or {label ""}}]
|
||||
(if dedupe
|
||||
@@ -91,23 +102,21 @@
|
||||
true))))
|
||||
|
||||
(defn submit!
|
||||
[& {:keys [::params ::task ::delay ::queue ::priority ::max-retries ::dedupe ::label]
|
||||
[& {:keys [::task ::delay ::queue ::priority ::max-retries ::conn ::dedupe ::label]
|
||||
:or {delay 0 queue :default priority 100 max-retries 3 label ""}
|
||||
:as options}]
|
||||
|
||||
(us/verify! ::submit-options options)
|
||||
(let [duration (dt/duration delay)
|
||||
interval (db/interval duration)
|
||||
props (db/tjson params)
|
||||
props (-> options extract-props db/tjson)
|
||||
id (uuid/next)
|
||||
tenant (cf/get :tenant)
|
||||
task (d/name task)
|
||||
queue (str/ffmt "%:%" tenant (d/name queue))
|
||||
conn (db/get-connectable options)
|
||||
deleted (when dedupe
|
||||
(-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
|
||||
:next.jdbc/update-count))]
|
||||
|
||||
(l/trc :hint "submit task"
|
||||
:name task
|
||||
:task-id (str id)
|
||||
@@ -117,13 +126,7 @@
|
||||
:delay (dt/format-duration duration)
|
||||
:replace (or deleted 0))
|
||||
|
||||
|
||||
(db/exec-one! conn [sql:insert-new-task id task props queue
|
||||
label priority max-retries interval])
|
||||
id))
|
||||
|
||||
(defn invoke!
|
||||
[{:keys [::task ::params] :as cfg}]
|
||||
(assert (contains? cfg :app.worker/registry)
|
||||
"missing worker registry on `cfg`")
|
||||
(let [task-fn (dm/get-in cfg [:app.worker/registry (name task)])]
|
||||
(task-fn {:props params})))
|
||||
|
||||
@@ -35,92 +35,8 @@
|
||||
[_ item]
|
||||
{:params item})
|
||||
|
||||
(defn- get-task
|
||||
[{:keys [::db/pool]} task-id]
|
||||
(ex/try!
|
||||
(some-> (db/get* pool :task {:id task-id})
|
||||
(decode-task-row))))
|
||||
|
||||
(defn- run-task
|
||||
[{:keys [::wrk/registry ::id ::queue] :as cfg} task]
|
||||
(try
|
||||
(l/dbg :hint "start"
|
||||
:name (:name task)
|
||||
:task-id (str (:id task))
|
||||
:queue queue
|
||||
:runner-id id
|
||||
:retry (:retry-num task))
|
||||
(let [tpoint (dt/tpoint)
|
||||
task-fn (get registry (:name task))
|
||||
result (if task-fn
|
||||
(task-fn task)
|
||||
{:status :completed :task task})
|
||||
elapsed (dt/format-duration (tpoint))]
|
||||
|
||||
(when-not task-fn
|
||||
(l/wrn :hint "no task handler found" :name (:name task)))
|
||||
|
||||
(l/dbg :hint "end"
|
||||
:name (:name task)
|
||||
:task-id (str (:id task))
|
||||
:queue queue
|
||||
:runner-id id
|
||||
:retry (:retry-num task)
|
||||
:elapsed elapsed)
|
||||
|
||||
result)
|
||||
|
||||
(catch InterruptedException cause
|
||||
(throw cause))
|
||||
(catch Throwable cause
|
||||
(let [edata (ex-data cause)]
|
||||
(if (and (< (:retry-num task)
|
||||
(:max-retries task))
|
||||
(= ::retry (:type edata)))
|
||||
(cond-> {:status :retry :task task :error cause}
|
||||
(dt/duration? (:delay edata))
|
||||
(assoc :delay (:delay edata))
|
||||
|
||||
(= ::noop (:strategy edata))
|
||||
(assoc :inc-by 0))
|
||||
(do
|
||||
(l/err :hint "unhandled exception on task"
|
||||
::l/context (get-error-context cause task)
|
||||
:cause cause)
|
||||
(if (>= (:retry-num task) (:max-retries task))
|
||||
{:status :failed :task task :error cause}
|
||||
{:status :retry :task task :error cause})))))))
|
||||
|
||||
(defn- run-task!
|
||||
[{:keys [::rds/rconn ::id] :as cfg} task-id]
|
||||
(loop [task (get-task cfg task-id)]
|
||||
(cond
|
||||
(ex/exception? task)
|
||||
(if (or (db/connection-error? task)
|
||||
(db/serialization-error? task))
|
||||
(do
|
||||
(l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
|
||||
:id id
|
||||
:cause task)
|
||||
(px/sleep (::rds/timeout rconn))
|
||||
(recur (get-task cfg task-id)))
|
||||
(do
|
||||
(l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
|
||||
:id id
|
||||
:cause task)
|
||||
(px/sleep (::rds/timeout rconn))
|
||||
(recur (get-task cfg task-id))))
|
||||
|
||||
(nil? task)
|
||||
(l/wrn :hint "no task found on the database"
|
||||
:id id
|
||||
:task-id task-id)
|
||||
|
||||
:else
|
||||
(run-task cfg task))))
|
||||
|
||||
(defn- run-worker-loop!
|
||||
[{:keys [::db/pool ::rds/rconn ::timeout ::queue] :as cfg}]
|
||||
[{:keys [::db/pool ::rds/rconn ::wrk/registry ::timeout ::queue ::id]}]
|
||||
(letfn [(handle-task-retry [{:keys [task error inc-by delay] :or {inc-by 1 delay 1000}}]
|
||||
(let [explain (ex-message error)
|
||||
nretry (+ (:retry-num task) inc-by)
|
||||
@@ -166,6 +82,88 @@
|
||||
:length (alength payload)
|
||||
:cause cause))))
|
||||
|
||||
(handle-task [{:keys [name] :as task}]
|
||||
(let [task-fn (get registry name)]
|
||||
(if task-fn
|
||||
(task-fn task)
|
||||
(l/wrn :hint "no task handler found" :name name))
|
||||
{:status :completed :task task}))
|
||||
|
||||
(handle-task-exception [cause task]
|
||||
(let [edata (ex-data cause)]
|
||||
(if (and (< (:retry-num task)
|
||||
(:max-retries task))
|
||||
(= ::retry (:type edata)))
|
||||
(cond-> {:status :retry :task task :error cause}
|
||||
(dt/duration? (:delay edata))
|
||||
(assoc :delay (:delay edata))
|
||||
|
||||
(= ::noop (:strategy edata))
|
||||
(assoc :inc-by 0))
|
||||
(do
|
||||
(l/err :hint "unhandled exception on task"
|
||||
::l/context (get-error-context cause task)
|
||||
:cause cause)
|
||||
(if (>= (:retry-num task) (:max-retries task))
|
||||
{:status :failed :task task :error cause}
|
||||
{:status :retry :task task :error cause})))))
|
||||
|
||||
(get-task [task-id]
|
||||
(ex/try!
|
||||
(some-> (db/get* pool :task {:id task-id})
|
||||
(decode-task-row))))
|
||||
|
||||
(run-task [task-id]
|
||||
(loop [task (get-task task-id)]
|
||||
(cond
|
||||
(ex/exception? task)
|
||||
(if (or (db/connection-error? task)
|
||||
(db/serialization-error? task))
|
||||
(do
|
||||
(l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
|
||||
:id id
|
||||
:cause task)
|
||||
(px/sleep (::rds/timeout rconn))
|
||||
(recur (get-task task-id)))
|
||||
(do
|
||||
(l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
|
||||
:id id
|
||||
:cause task)
|
||||
(px/sleep (::rds/timeout rconn))
|
||||
(recur (get-task task-id))))
|
||||
|
||||
(nil? task)
|
||||
(l/wrn :hint "no task found on the database"
|
||||
:id id
|
||||
:task-id task-id)
|
||||
|
||||
:else
|
||||
(try
|
||||
(l/dbg :hint "start"
|
||||
:name (:name task)
|
||||
:task-id (str task-id)
|
||||
:queue queue
|
||||
:runner-id id
|
||||
:retry (:retry-num task))
|
||||
(let [tpoint (dt/tpoint)
|
||||
result (handle-task task)
|
||||
elapsed (dt/format-duration (tpoint))]
|
||||
|
||||
(l/dbg :hint "end"
|
||||
:name (:name task)
|
||||
:task-id (str task-id)
|
||||
:queue queue
|
||||
:runner-id id
|
||||
:retry (:retry-num task)
|
||||
:elapsed elapsed)
|
||||
|
||||
result)
|
||||
|
||||
(catch InterruptedException cause
|
||||
(throw cause))
|
||||
(catch Throwable cause
|
||||
(handle-task-exception cause task))))))
|
||||
|
||||
(process-result [{:keys [status] :as result}]
|
||||
(ex/try!
|
||||
(case status
|
||||
@@ -175,7 +173,7 @@
|
||||
nil)))
|
||||
|
||||
(run-task-loop [task-id]
|
||||
(loop [result (run-task! cfg task-id)]
|
||||
(loop [result (run-task task-id)]
|
||||
(when-let [cause (process-result result)]
|
||||
(if (or (db/connection-error? cause)
|
||||
(db/serialization-error? cause))
|
||||
|
||||
@@ -34,8 +34,6 @@
|
||||
[app.util.blob :as blob]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[app.worker.runner]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.test :as t]
|
||||
@@ -79,6 +77,47 @@
|
||||
:enable-feature-components-v2
|
||||
:disable-file-validation])
|
||||
|
||||
(def test-init-sql
|
||||
["alter table project_profile_rel set unlogged;\n"
|
||||
"alter table file_profile_rel set unlogged;\n"
|
||||
"alter table presence set unlogged;\n"
|
||||
"alter table presence set unlogged;\n"
|
||||
"alter table http_session set unlogged;\n"
|
||||
"alter table team_profile_rel set unlogged;\n"
|
||||
"alter table team_project_profile_rel set unlogged;\n"
|
||||
"alter table comment_thread_status set unlogged;\n"
|
||||
"alter table comment set unlogged;\n"
|
||||
"alter table comment_thread set unlogged;\n"
|
||||
"alter table profile_complaint_report set unlogged;\n"
|
||||
"alter table file_change set unlogged;\n"
|
||||
"alter table team_font_variant set unlogged;\n"
|
||||
"alter table share_link set unlogged;\n"
|
||||
"alter table usage_quote set unlogged;\n"
|
||||
"alter table access_token set unlogged;\n"
|
||||
"alter table profile set unlogged;\n"
|
||||
"alter table file_library_rel set unlogged;\n"
|
||||
"alter table file_thumbnail set unlogged;\n"
|
||||
"alter table file_object_thumbnail set unlogged;\n"
|
||||
"alter table file_tagged_object_thumbnail set unlogged;\n"
|
||||
"alter table file_media_object set unlogged;\n"
|
||||
"alter table file_data_fragment set unlogged;\n"
|
||||
"alter table file set unlogged;\n"
|
||||
"alter table project set unlogged;\n"
|
||||
"alter table team_invitation set unlogged;\n"
|
||||
"alter table webhook_delivery set unlogged;\n"
|
||||
"alter table webhook set unlogged;\n"
|
||||
"alter table team set unlogged;\n"
|
||||
;; For some reason, modifying the task realted tables is very very
|
||||
;; slow (5s); so we just don't alter them
|
||||
;; "alter table task set unlogged;\n"
|
||||
;; "alter table task_default set unlogged;\n"
|
||||
;; "alter table task_completed set unlogged;\n"
|
||||
"alter table audit_log set unlogged ;\n"
|
||||
"alter table storage_object set unlogged;\n"
|
||||
"alter table server_error_report set unlogged;\n"
|
||||
"alter table server_prop set unlogged;\n"
|
||||
"alter table global_complaint_report set unlogged;\n"])
|
||||
|
||||
(defn state-init
|
||||
[next]
|
||||
(with-redefs [app.config/flags (flags/parse flags/default default-flags)
|
||||
@@ -125,6 +164,9 @@
|
||||
(try
|
||||
(binding [*system* system
|
||||
*pool* (:app.db/pool system)]
|
||||
(db/with-atomic [conn *pool*]
|
||||
(doseq [sql test-init-sql]
|
||||
(db/exec! conn [sql])))
|
||||
(next))
|
||||
(finally
|
||||
(ig/halt! system))))))
|
||||
@@ -139,7 +181,8 @@
|
||||
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
||||
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
||||
(let [result (->> (db/exec! conn [sql])
|
||||
(map :table-name))]
|
||||
(map :table-name)
|
||||
(remove #(= "task" %)))]
|
||||
(doseq [table result]
|
||||
(db/exec! conn [(str "delete from " table ";")]))))
|
||||
|
||||
@@ -220,7 +263,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))
|
||||
@@ -378,21 +421,9 @@
|
||||
([name]
|
||||
(run-task! name {}))
|
||||
([name params]
|
||||
(wrk/invoke! (-> *system*
|
||||
(assoc ::wrk/task name)
|
||||
(assoc ::wrk/params params)))))
|
||||
|
||||
(def sql:pending-tasks
|
||||
"select t.* from task as t
|
||||
where t.status = 'new'
|
||||
order by t.priority desc, t.scheduled_at")
|
||||
|
||||
(defn run-pending-tasks!
|
||||
[]
|
||||
(db/tx-run! *system* (fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [tasks (->> (db/exec! conn [sql:pending-tasks])
|
||||
(map #'app.worker.runner/decode-task-row))]
|
||||
(run! (partial #'app.worker.runner/run-task cfg) tasks)))))
|
||||
(let [tasks (:app.worker/registry *system*)]
|
||||
(let [task-fn (get tasks (d/name name))]
|
||||
(task-fn params)))))
|
||||
|
||||
;; --- UTILS
|
||||
|
||||
|
||||
@@ -21,10 +21,11 @@
|
||||
(with-mocks [submit-mock {:target 'app.worker/submit! :return nil}]
|
||||
(let [prof (th/create-profile* 1 {:is-active true})
|
||||
res (th/run-task! :process-webhook-event
|
||||
{:event
|
||||
{:type "command"
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}})]
|
||||
{:props
|
||||
{:app.loggers.webhooks/event
|
||||
{:type "command"
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}}})]
|
||||
|
||||
(t/is (= 0 (:call-count @submit-mock)))
|
||||
(t/is (nil? res)))))
|
||||
@@ -34,10 +35,11 @@
|
||||
(let [prof (th/create-profile* 1 {:is-active true})
|
||||
whk (th/create-webhook* {:team-id (:default-team-id prof)})
|
||||
res (th/run-task! :process-webhook-event
|
||||
{:event
|
||||
{:type "command"
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}})]
|
||||
{:props
|
||||
{:app.loggers.webhooks/event
|
||||
{:type "command"
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}}})]
|
||||
|
||||
(t/is (= 1 (:call-count @submit-mock)))
|
||||
(t/is (nil? res)))))
|
||||
@@ -50,8 +52,9 @@
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}
|
||||
res (th/run-task! :run-webhook
|
||||
{:event evt
|
||||
:config whk})]
|
||||
{:props
|
||||
{:app.loggers.webhooks/event evt
|
||||
:app.loggers.webhooks/config whk}})]
|
||||
|
||||
(t/is (= 1 (:call-count @http-mock)))
|
||||
|
||||
@@ -72,8 +75,9 @@
|
||||
:name "create-project"
|
||||
:props {:team-id (:default-team-id prof)}}
|
||||
res (th/run-task! :run-webhook
|
||||
{:event evt
|
||||
:config whk})]
|
||||
{:props
|
||||
{:app.loggers.webhooks/event evt
|
||||
:app.loggers.webhooks/config whk}})]
|
||||
|
||||
(t/is (= 1 (:call-count @http-mock)))
|
||||
|
||||
@@ -90,12 +94,14 @@
|
||||
;; RUN 2 times more
|
||||
|
||||
(th/run-task! :run-webhook
|
||||
{:event evt
|
||||
:config whk})
|
||||
{:props
|
||||
{:app.loggers.webhooks/event evt
|
||||
:app.loggers.webhooks/config whk}})
|
||||
|
||||
(th/run-task! :run-webhook
|
||||
{:event evt
|
||||
:config whk})
|
||||
{:props
|
||||
{:app.loggers.webhooks/event evt
|
||||
:app.loggers.webhooks/config whk}})
|
||||
|
||||
|
||||
(let [rows (th/db-query :webhook-delivery {:webhook-id (:id whk)})]
|
||||
|
||||
@@ -1189,7 +1189,6 @@
|
||||
(t/is (nil? error))
|
||||
(t/is (map? result)))
|
||||
|
||||
;; insert another thumbnail with different revn
|
||||
(let [data {::th/type :create-file-thumbnail
|
||||
::rpc/profile-id (:id prof)
|
||||
:file-id (:id file)
|
||||
@@ -1208,6 +1207,8 @@
|
||||
(t/is (= 2 (count rows)))))
|
||||
|
||||
(t/testing "gc task"
|
||||
;; make the file eligible for GC waiting 300ms (configured
|
||||
;; timeout for testing)
|
||||
(let [res (th/run-task! :file-gc {:min-age 0})]
|
||||
(t/is (= 1 (:processed res))))
|
||||
|
||||
|
||||
@@ -346,5 +346,13 @@
|
||||
(assoc :size 312043))))
|
||||
out (th/command! data)]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (map? (:result out))))))
|
||||
(t/is (map? (:result out))))
|
||||
|
||||
(let [[row1 :as rows]
|
||||
(->> (th/db-query :task {:name "object-update"})
|
||||
(map #(update % :props db/decode-transit-pgobject)))]
|
||||
|
||||
;; (app.common.pprint/pprint rows)
|
||||
(t/is (= 1 (count rows)))
|
||||
(t/is (> (inst-ms (dt/diff (:created-at row1) (:scheduled-at row1)))
|
||||
(inst-ms (dt/duration "4m")))))))
|
||||
|
||||
@@ -6,11 +6,10 @@
|
||||
|
||||
(ns backend-tests.rpc-profile-test
|
||||
(:require
|
||||
[app.auth :as auth]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.email.blacklist :as email.blacklist]
|
||||
[app.email.whitelist :as email.whitelist]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.tokens :as tokens]
|
||||
@@ -127,7 +126,7 @@
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:error out)))))))
|
||||
|
||||
(t/deftest profile-deletion-1
|
||||
(t/deftest profile-deletion-simple
|
||||
(let [prof (th/create-profile* 1)
|
||||
file (th/create-file* 1 {:profile-id (:id prof)
|
||||
:project-id (:default-project-id prof)
|
||||
@@ -153,22 +152,23 @@
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= 1 (count (:result out)))))
|
||||
|
||||
(th/run-pending-tasks!)
|
||||
;; execute permanent deletion task
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 1 (:processed result))))
|
||||
|
||||
(let [row (th/db-get :team
|
||||
{:id (:default-team-id prof)}
|
||||
{::db/remove-deleted false})]
|
||||
(t/is (nil? (:deleted-at row))))
|
||||
|
||||
(let [result (th/run-task! :orphan-teams-gc {:min-age 0})]
|
||||
(t/is (= 1 (:processed result))))
|
||||
|
||||
(let [row (th/db-get :team
|
||||
{:id (:default-team-id prof)}
|
||||
{::db/remove-deleted false})]
|
||||
(t/is (dt/instant? (:deleted-at row))))
|
||||
|
||||
;; execute permanent deletion task
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 4 (:processed result))))
|
||||
|
||||
(let [row (th/db-get :team
|
||||
{:id (:default-team-id prof)}
|
||||
{::db/remove-deleted false})]
|
||||
(t/is (nil? row)))
|
||||
|
||||
;; query profile after delete
|
||||
(let [params {::th/type :get-profile
|
||||
::rpc/profile-id (:id prof)}
|
||||
@@ -177,187 +177,14 @@
|
||||
(let [result (:result out)]
|
||||
(t/is (= uuid/zero (:id result)))))))
|
||||
|
||||
(t/deftest profile-deletion-2
|
||||
(let [prof1 (th/create-profile* 1)
|
||||
prof2 (th/create-profile* 2)
|
||||
file1 (th/create-file* 1 {:profile-id (:id prof1)
|
||||
:project-id (:default-project-id prof1)
|
||||
:is-shared false})
|
||||
team1 (th/create-team* 1 {:profile-id (:id prof1)})
|
||||
(t/deftest registration-domain-whitelist
|
||||
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
|
||||
(t/testing "allowed email domain"
|
||||
(t/is (true? (auth/email-domain-in-whitelist? whitelist "username@ya.ru")))
|
||||
(t/is (true? (auth/email-domain-in-whitelist? #{} "username@somedomain.com"))))
|
||||
|
||||
role1 (th/create-team-role* {:team-id (:id team1)
|
||||
:profile-id (:id prof2)
|
||||
|
||||
:role :editor})]
|
||||
;; Assert all roles for team
|
||||
(let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
|
||||
(t/is (= 2 (count roles))))
|
||||
|
||||
;; Request profile to be deleted
|
||||
(let [params {::th/type :delete-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
|
||||
(let [error (:error out)
|
||||
edata (ex-data error)]
|
||||
(t/is (th/ex-info? error))
|
||||
(t/is (= (:type edata) :validation))
|
||||
(t/is (= (:code edata) :owner-teams-with-people))))))
|
||||
|
||||
(t/deftest profile-deletion-3
|
||||
(let [prof1 (th/create-profile* 1)
|
||||
prof2 (th/create-profile* 2)
|
||||
prof3 (th/create-profile* 3)
|
||||
file1 (th/create-file* 1 {:profile-id (:id prof1)
|
||||
:project-id (:default-project-id prof1)
|
||||
:is-shared false})
|
||||
team1 (th/create-team* 1 {:profile-id (:id prof1)})
|
||||
|
||||
role1 (th/create-team-role* {:team-id (:id team1)
|
||||
:profile-id (:id prof2)
|
||||
:role :editor})
|
||||
role2 (th/create-team-role* {:team-id (:id team1)
|
||||
:profile-id (:id prof3)
|
||||
:role :editor})]
|
||||
|
||||
;; Assert all roles for team
|
||||
(let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
|
||||
(t/is (= 3 (count roles))))
|
||||
|
||||
;; Request profile to be deleted (it should fail)
|
||||
(let [params {::th/type :delete-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
|
||||
(let [error (:error out)
|
||||
edata (ex-data error)]
|
||||
(t/is (th/ex-info? error))
|
||||
(t/is (= (:type edata) :validation))
|
||||
(t/is (= (:code edata) :owner-teams-with-people))))
|
||||
|
||||
;; Leave team by role 1
|
||||
(let [params {::th/type :leave-team
|
||||
::rpc/profile-id (:id prof2)
|
||||
:id (:id team1)}
|
||||
out (th/command! params)]
|
||||
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:result out)))
|
||||
(t/is (nil? (:error out))))
|
||||
|
||||
;; Request profile to be deleted (it should fail)
|
||||
(let [params {::th/type :delete-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
(let [error (:error out)
|
||||
edata (ex-data error)]
|
||||
(t/is (th/ex-info? error))
|
||||
(t/is (= (:type edata) :validation))
|
||||
(t/is (= (:code edata) :owner-teams-with-people))))
|
||||
|
||||
;; Leave team by role 0 (the default) and reassing owner to role 3
|
||||
;; without reassinging it (should fail)
|
||||
(let [params {::th/type :leave-team
|
||||
::rpc/profile-id (:id prof1)
|
||||
;; :reassign-to (:id prof3)
|
||||
:id (:id team1)}
|
||||
out (th/command! params)]
|
||||
|
||||
;; (th/print-result! out)
|
||||
|
||||
(let [error (:error out)
|
||||
edata (ex-data error)]
|
||||
(t/is (th/ex-info? error))
|
||||
(t/is (= (:type edata) :validation))
|
||||
(t/is (= (:code edata) :owner-cant-leave-team))))
|
||||
|
||||
;; Leave team by role 0 (the default) and reassing owner to role 3
|
||||
(let [params {::th/type :leave-team
|
||||
::rpc/profile-id (:id prof1)
|
||||
:reassign-to (:id prof3)
|
||||
:id (:id team1)}
|
||||
out (th/command! params)]
|
||||
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:result out)))
|
||||
(t/is (nil? (:error out))))
|
||||
|
||||
;; Request profile to be deleted
|
||||
(let [params {::th/type :delete-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
|
||||
(t/is (= {} (:result out)))
|
||||
(t/is (nil? (:error out))))
|
||||
|
||||
;; query files after profile soft deletion
|
||||
(let [params {::th/type :get-project-files
|
||||
::rpc/profile-id (:id prof1)
|
||||
:project-id (:default-project-id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= 1 (count (:result out)))))
|
||||
|
||||
(th/run-pending-tasks!)
|
||||
|
||||
;; execute permanent deletion task
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 4 (:processed result))))
|
||||
|
||||
(let [row (th/db-get :team
|
||||
{:id (:default-team-id prof1)}
|
||||
{::db/remove-deleted false})]
|
||||
(t/is (nil? row)))
|
||||
|
||||
;; query profile after delete
|
||||
(let [params {::th/type :get-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
(let [result (:result out)]
|
||||
(t/is (= uuid/zero (:id result)))))))
|
||||
|
||||
|
||||
(t/deftest profile-deletion-4
|
||||
(let [prof1 (th/create-profile* 1)
|
||||
file1 (th/create-file* 1 {:profile-id (:id prof1)
|
||||
:project-id (:default-project-id prof1)
|
||||
:is-shared false})
|
||||
team1 (th/create-team* 1 {:profile-id (:id prof1)})
|
||||
team2 (th/create-team* 2 {:profile-id (:id prof1)})]
|
||||
|
||||
;; Request profile to be deleted
|
||||
(let [params {::th/type :delete-profile
|
||||
::rpc/profile-id (:id prof1)}
|
||||
out (th/command! params)]
|
||||
;; (th/print-result! out)
|
||||
(t/is (= {} (:result out)))
|
||||
(t/is (nil? (:error out))))
|
||||
|
||||
(th/run-pending-tasks!)
|
||||
|
||||
(let [rows (th/db-exec! ["select id,name,deleted_at from team where deleted_at is not null"])]
|
||||
(t/is (= 3 (count rows))))
|
||||
|
||||
;; execute permanent deletion task
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 8 (:processed result))))))
|
||||
|
||||
|
||||
(t/deftest email-blacklist-1
|
||||
(t/is (false? (email.blacklist/enabled? th/*system*)))
|
||||
(t/is (true? (email.blacklist/enabled? (assoc th/*system* :app.email/blacklist []))))
|
||||
(t/is (true? (email.blacklist/contains? (assoc th/*system* :app.email/blacklist #{"foo.com"}) "AA@FOO.COM"))))
|
||||
|
||||
(t/deftest email-whitelist-1
|
||||
(t/is (false? (email.whitelist/enabled? th/*system*)))
|
||||
(t/is (true? (email.whitelist/enabled? (assoc th/*system* :app.email/whitelist []))))
|
||||
(t/is (true? (email.whitelist/contains? (assoc th/*system* :app.email/whitelist #{"foo.com"}) "AA@FOO.COM"))))
|
||||
(t/testing "not allowed email domain"
|
||||
(t/is (false? (auth/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
|
||||
|
||||
(t/deftest prepare-register-and-register-profile-1
|
||||
(let [data {::th/type :prepare-register-profile
|
||||
|
||||
@@ -391,8 +391,6 @@
|
||||
(t/is (= 1 (count result)))
|
||||
(t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
|
||||
|
||||
(th/run-pending-tasks!)
|
||||
|
||||
;; run permanent deletion (should be noop)
|
||||
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
|
||||
(t/is (= 0 (:processed result))))
|
||||
@@ -459,8 +457,6 @@
|
||||
#_(th/print-result! out)
|
||||
(t/is (nil? (:error out))))
|
||||
|
||||
(th/run-pending-tasks!)
|
||||
|
||||
(let [rows (th/db-exec! ["select * from team where id = ?" (:id team)])]
|
||||
(t/is (= 1 (count rows)))
|
||||
(t/is (dt/instant? (:deleted-at (first rows)))))
|
||||
|
||||
@@ -2,5 +2,4 @@
|
||||
{:tests
|
||||
[{:id :unit
|
||||
:test-paths ["test" "src"]
|
||||
:ns-patterns [".*-test$"]
|
||||
:kaocha/reporter [kaocha.report/dots]}]}
|
||||
:ns-patterns [".*-test$"]}]}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,10 +1,10 @@
|
||||
{:deps
|
||||
{org.clojure/clojure {:mvn/version "1.11.2"}
|
||||
org.clojure/data.json {:mvn/version "2.5.0"}
|
||||
org.clojure/tools.cli {:mvn/version "1.1.230"}
|
||||
org.clojure/tools.cli {:mvn/version "1.0.219"}
|
||||
org.clojure/clojurescript {:mvn/version "1.11.132"}
|
||||
org.clojure/test.check {:mvn/version "1.1.1"}
|
||||
org.clojure/data.fressian {:mvn/version "1.1.0"}
|
||||
org.clojure/data.fressian {:mvn/version "1.0.0"}
|
||||
|
||||
;; Logging
|
||||
org.apache.logging.log4j/log4j-api {:mvn/version "2.23.1"}
|
||||
@@ -12,14 +12,14 @@
|
||||
org.apache.logging.log4j/log4j-web {:mvn/version "2.23.1"}
|
||||
org.apache.logging.log4j/log4j-jul {:mvn/version "2.23.1"}
|
||||
org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.23.1"}
|
||||
org.slf4j/slf4j-api {:mvn/version "2.0.13"}
|
||||
org.slf4j/slf4j-api {:mvn/version "2.0.12"}
|
||||
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
|
||||
|
||||
selmer/selmer {:mvn/version "1.12.61"}
|
||||
selmer/selmer {:mvn/version "1.12.59"}
|
||||
criterium/criterium {:mvn/version "0.4.6"}
|
||||
|
||||
metosin/jsonista {:mvn/version "0.3.8"}
|
||||
metosin/malli {:mvn/version "0.16.1"}
|
||||
metosin/malli {:mvn/version "0.14.0"}
|
||||
|
||||
expound/expound {:mvn/version "0.9.0"}
|
||||
com.cognitect/transit-clj {:mvn/version "1.0.333"}
|
||||
@@ -28,7 +28,7 @@
|
||||
integrant/integrant {:mvn/version "0.8.1"}
|
||||
|
||||
org.apache.commons/commons-pool2 {:mvn/version "2.12.0"}
|
||||
org.graalvm.js/js {:mvn/version "23.0.4"}
|
||||
org.graalvm.js/js {:mvn/version "23.0.3"}
|
||||
|
||||
funcool/tubax {:mvn/version "2021.05.20-0"}
|
||||
funcool/cuerdas {:mvn/version "2023.11.09-407"}
|
||||
@@ -63,7 +63,7 @@
|
||||
{:dev
|
||||
{:extra-deps
|
||||
{org.clojure/tools.namespace {:mvn/version "RELEASE"}
|
||||
thheller/shadow-cljs {:mvn/version "2.28.8"}
|
||||
thheller/shadow-cljs {:mvn/version "2.27.4"}
|
||||
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
|
||||
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
|
||||
criterium/criterium {:mvn/version "RELEASE"}
|
||||
@@ -72,12 +72,16 @@
|
||||
|
||||
:build
|
||||
{:extra-deps
|
||||
{io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
|
||||
{io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
|
||||
:ns-default build}
|
||||
|
||||
:test
|
||||
{:main-opts ["-m" "kaocha.runner"]
|
||||
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
|
||||
{:extra-paths ["test"]
|
||||
:extra-deps
|
||||
{io.github.cognitect-labs/test-runner
|
||||
{:git/tag "v0.5.1" :git/sha "dfb30dd"}}
|
||||
:main-opts ["-m" "cognitect.test-runner"]
|
||||
:exec-fn cognitect.test-runner.api/test}
|
||||
|
||||
:shadow-cljs
|
||||
{:main-opts ["-m" "shadow.cljs.devtools.cli"]}
|
||||
|
||||
@@ -5,19 +5,19 @@
|
||||
"license": "MPL-2.0",
|
||||
"author": "Kaleidos INC",
|
||||
"private": true,
|
||||
"packageManager": "yarn@4.2.2",
|
||||
"packageManager": "yarn@4.0.2",
|
||||
"repository": {
|
||||
"type": "git",
|
||||
"url": "https://github.com/penpot/penpot"
|
||||
},
|
||||
"dependencies": {
|
||||
"luxon": "^3.4.4",
|
||||
"sax": "^1.4.1"
|
||||
"luxon": "^3.4.2",
|
||||
"sax": "^1.2.4"
|
||||
},
|
||||
"devDependencies": {
|
||||
"shadow-cljs": "2.28.8",
|
||||
"shadow-cljs": "2.27.4",
|
||||
"source-map-support": "^0.5.21",
|
||||
"ws": "^8.17.0"
|
||||
"ws": "^8.13.0"
|
||||
},
|
||||
"scripts": {
|
||||
"fmt:clj:check": "cljfmt check --parallel=false src/ test/",
|
||||
|
||||
@@ -274,13 +274,6 @@
|
||||
(catch #?(:clj Throwable :cljs :default) _cause
|
||||
[0 0 0])))
|
||||
|
||||
(defn hex->lum
|
||||
[color]
|
||||
(let [[r g b] (hex->rgb color)]
|
||||
(mth/sqrt (+ (* 0.241 r)
|
||||
(* 0.691 g)
|
||||
(* 0.068 b)))))
|
||||
|
||||
(defn- int->hex
|
||||
"Convert integer to hex string"
|
||||
[v]
|
||||
@@ -462,19 +455,3 @@
|
||||
|
||||
:else
|
||||
[r g (inc b)]))
|
||||
|
||||
(defn reduce-range
|
||||
[value range]
|
||||
(/ (mth/floor (* value range)) range))
|
||||
|
||||
(defn sort-colors
|
||||
[a b]
|
||||
(let [[ah _ av] (hex->hsv (:color a))
|
||||
[bh _ bv] (hex->hsv (:color b))
|
||||
ah (reduce-range (/ ah 60) 8)
|
||||
bh (reduce-range (/ bh 60) 8)
|
||||
av (/ av 255)
|
||||
bv (/ bv 255)
|
||||
a (+ (* ah 100) (* av 10))
|
||||
b (+ (* bh 100) (* bv 10))]
|
||||
(compare a b)))
|
||||
|
||||
@@ -224,6 +224,7 @@
|
||||
[coll]
|
||||
(into [] (remove nil?) coll))
|
||||
|
||||
|
||||
(defn without-nils
|
||||
"Given a map, return a map removing key-value
|
||||
pairs when value is `nil`."
|
||||
|
||||
@@ -48,8 +48,7 @@
|
||||
"fdata/shape-data-type"
|
||||
"components/v2"
|
||||
"styles/v2"
|
||||
"layout/grid"
|
||||
"plugins/runtime"})
|
||||
"layout/grid"})
|
||||
|
||||
;; A set of features enabled by default
|
||||
(def default-features
|
||||
@@ -63,8 +62,7 @@
|
||||
;; persist on file features field but can be permanently enabled on
|
||||
;; team feature field
|
||||
(def frontend-only-features
|
||||
#{"styles/v2"
|
||||
"plugins/runtime"})
|
||||
#{"styles/v2"})
|
||||
|
||||
;; Features that are mainly backend only or there are a proper
|
||||
;; fallback when frontend reports no support for it
|
||||
@@ -80,8 +78,7 @@
|
||||
(-> #{"fdata/objects-map"
|
||||
"fdata/pointer-map"
|
||||
"layout/grid"
|
||||
"fdata/shape-data-type"
|
||||
"plugins/runtime"}
|
||||
"fdata/shape-data-type"}
|
||||
(into frontend-only-features)))
|
||||
|
||||
(sm/def! ::features
|
||||
@@ -100,7 +97,6 @@
|
||||
:feature-grid-layout "layout/grid"
|
||||
:feature-fdata-objects-map "fdata/objects-map"
|
||||
:feature-fdata-pointer-map "fdata/pointer-map"
|
||||
:feature-plugins "plugins/runtime"
|
||||
nil))
|
||||
|
||||
(defn migrate-legacy-features
|
||||
|
||||
@@ -38,22 +38,17 @@
|
||||
fail-on-spec?]
|
||||
:or {add-container? false
|
||||
fail-on-spec? false}}]
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
component-id (:current-component-id file)
|
||||
change (cond-> change
|
||||
(and add-container? (some? component-id) (not components-v2))
|
||||
(-> (assoc :component-id component-id)
|
||||
(cond-> (some? (:current-frame-id file))
|
||||
(assoc :frame-id (:current-frame-id file))))
|
||||
(let [component-id (:current-component-id file)
|
||||
change (cond-> change
|
||||
(and add-container? (some? component-id))
|
||||
(-> (assoc :component-id component-id)
|
||||
(cond-> (some? (:current-frame-id file))
|
||||
(assoc :frame-id (:current-frame-id file))))
|
||||
|
||||
(and add-container? (or (nil? component-id) components-v2))
|
||||
(assoc :page-id (:current-page-id file)
|
||||
:frame-id (:current-frame-id file)))
|
||||
|
||||
valid? (or (and components-v2
|
||||
(nil? (:component-id change))
|
||||
(nil? (:page-id change)))
|
||||
(ch/check-change! change))]
|
||||
(and add-container? (nil? component-id))
|
||||
(assoc :page-id (:current-page-id file)
|
||||
:frame-id (:current-frame-id file)))
|
||||
valid? (ch/check-change! change)]
|
||||
|
||||
(when-not valid?
|
||||
(let [explain (sm/explain ::ch/change change)]
|
||||
@@ -65,12 +60,12 @@
|
||||
::sm/explain explain))))
|
||||
|
||||
(cond-> file
|
||||
(and valid? (or (not add-container?) (some? (:component-id change)) (some? (:page-id change))))
|
||||
(-> (update :changes conjv change) ;; In components-v2 we do not add shapes
|
||||
(update :data ch/process-changes [change] false)) ;; inside a component
|
||||
valid?
|
||||
(-> (update :changes conjv change)
|
||||
(update :data ch/process-changes [change] false))
|
||||
|
||||
(not valid?)
|
||||
(update :errors conjv change)))));)
|
||||
(update :errors conjv change)))))
|
||||
|
||||
(defn- lookup-objects
|
||||
([file]
|
||||
@@ -140,14 +135,19 @@
|
||||
(create-file (uuid/next) name))
|
||||
|
||||
([id name]
|
||||
(-> (ctf/make-file {:id id :name name :create-page false})
|
||||
(assoc :changes [])))) ;; We keep the changes so we can send them to the backend
|
||||
{:id id
|
||||
:name name
|
||||
:data (-> ctf/empty-file-data
|
||||
(assoc :id id))
|
||||
|
||||
;; We keep the changes so we can send them to the backend
|
||||
:changes []}))
|
||||
|
||||
(defn add-page
|
||||
[file data]
|
||||
(dm/assert! (nil? (:current-component-id file)))
|
||||
(let [page-id (or (:id data) (uuid/next))
|
||||
page (-> (ctp/make-empty-page {:id page-id :name "Page 1"})
|
||||
page (-> (ctp/make-empty-page page-id "Page 1")
|
||||
(d/deep-merge data))]
|
||||
(-> file
|
||||
(commit-change
|
||||
@@ -185,11 +185,10 @@
|
||||
(update :parent-stack conjv (:id obj)))))
|
||||
|
||||
(defn close-artboard [file]
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
parent-id (-> file :parent-stack peek)
|
||||
(let [parent-id (-> file :parent-stack peek)
|
||||
parent (lookup-shape file parent-id)
|
||||
current-frame-id (or (:frame-id parent)
|
||||
(when (or (nil? (:current-component-id file)) components-v2)
|
||||
(when (nil? (:current-component-id file))
|
||||
root-id))]
|
||||
(-> file
|
||||
(assoc :current-frame-id current-frame-id)
|
||||
@@ -512,26 +511,17 @@
|
||||
{:type :del-media
|
||||
:id id}))))
|
||||
|
||||
(defn start-component
|
||||
([file data]
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
root-type (if components-v2 :frame :group)]
|
||||
(start-component file data root-type)))
|
||||
|
||||
(defn start-component
|
||||
([file data] (start-component file data :group))
|
||||
([file data root-type]
|
||||
;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
|
||||
(let [selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
|
||||
grc/empty-rect)
|
||||
name (:name data)
|
||||
path (:path data)
|
||||
main-instance-id (:main-instance-id data)
|
||||
main-instance-page (:main-instance-page data)
|
||||
|
||||
;; In components v1 we must create the root shape and set it inside
|
||||
;; the :objects attribute of the component. When in components-v2,
|
||||
;; this will be ignored as the root shape has already been created
|
||||
;; in its page, by the normal page import.
|
||||
attrs (-> data
|
||||
(assoc :type root-type)
|
||||
(assoc :x (:x selrect))
|
||||
@@ -553,43 +543,19 @@
|
||||
|
||||
(-> file
|
||||
(commit-change
|
||||
(cond-> {:type :add-component
|
||||
:id (:id obj)
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page}
|
||||
(not components-v2)
|
||||
(assoc :shapes [obj])))
|
||||
{:type :add-component
|
||||
:id (:id obj)
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page
|
||||
:shapes [obj]})
|
||||
|
||||
(assoc :last-id (:id obj))
|
||||
(assoc :parent-stack [(:id obj)])
|
||||
(assoc :current-component-id (:id obj))
|
||||
(assoc :current-frame-id (if (= (:type obj) :frame) (:id obj) uuid/zero))))))
|
||||
|
||||
(defn start-deleted-component
|
||||
[file data]
|
||||
(let [attrs (-> data
|
||||
(assoc :id (:main-instance-id data))
|
||||
(assoc :component-file (:id file))
|
||||
(assoc :component-id (:id data))
|
||||
(assoc :x (:main-instance-x data))
|
||||
(assoc :y (:main-instance-y data))
|
||||
(dissoc :path)
|
||||
(dissoc :main-instance-id)
|
||||
(dissoc :main-instance-page)
|
||||
(dissoc :main-instance-x)
|
||||
(dissoc :main-instance-y)
|
||||
(dissoc :main-instance-parent)
|
||||
(dissoc :main-instance-frame))]
|
||||
;; To create a deleted component, first we add all shapes of the main instance
|
||||
;; in the main instance page, and in the finish event we delete it.
|
||||
(-> file
|
||||
(update :parent-stack conjv (:main-instance-parent data))
|
||||
(assoc :current-page-id (:main-instance-page data))
|
||||
(assoc :current-frame-id (:main-instance-frame data))
|
||||
(add-artboard attrs))))
|
||||
|
||||
(defn finish-component
|
||||
[file]
|
||||
(let [component-id (:current-component-id file)
|
||||
@@ -600,11 +566,9 @@
|
||||
|
||||
file
|
||||
(cond
|
||||
;; In components-v2 components haven't any shape inside them.
|
||||
;; Components-v2 component we skip this step
|
||||
(and component-data (:main-instance-id component-data))
|
||||
(update file :data
|
||||
(fn [data]
|
||||
(ctkl/update-component data component-id dissoc :objects)))
|
||||
file
|
||||
|
||||
(empty? children)
|
||||
(commit-change
|
||||
@@ -654,18 +618,43 @@
|
||||
(update :parent-stack pop))))
|
||||
|
||||
(defn finish-deleted-component
|
||||
[component-id file]
|
||||
[component-id page-id main-instance-x main-instance-y file]
|
||||
(let [file (assoc file :current-component-id component-id)
|
||||
component (ctkl/get-component (:data file) component-id)]
|
||||
(-> file
|
||||
(close-artboard)
|
||||
(commit-change {:type :del-component
|
||||
page (ctpl/get-page (:data file) page-id)
|
||||
component (ctkl/get-component (:data file) component-id)
|
||||
main-instance-id (:main-instance-id component)
|
||||
|
||||
; To obtain a deleted component, we first create the component
|
||||
; and the main instance in the workspace, and then delete them.
|
||||
[_ shapes]
|
||||
(ctn/make-component-instance page
|
||||
component
|
||||
(:data file)
|
||||
(gpt/point main-instance-x
|
||||
main-instance-y)
|
||||
true
|
||||
{:main-instance true
|
||||
:force-id main-instance-id})]
|
||||
(as-> 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})
|
||||
$
|
||||
shapes)
|
||||
(commit-change $ {:type :del-component
|
||||
:id component-id})
|
||||
(commit-change {:type :del-obj
|
||||
:page-id (:main-instance-page component)
|
||||
:id (:main-instance-id component)
|
||||
:ignore-touched true})
|
||||
(dissoc :current-page-id))))
|
||||
(reduce #(commit-change %1 {:type :del-obj
|
||||
:page-id page-id
|
||||
:ignore-touched true
|
||||
:id (:id %2)})
|
||||
$
|
||||
shapes)
|
||||
(dissoc $ :current-component-id))))
|
||||
|
||||
(defn create-component-instance
|
||||
[file data]
|
||||
@@ -676,6 +665,7 @@
|
||||
page-id (:current-page-id file)
|
||||
page (ctpl/get-page (:data file) page-id)
|
||||
component (ctkl/get-component (:data file) component-id)
|
||||
;; main-instance-id (:main-instance-id component)
|
||||
|
||||
components-v2 (dm/get-in file [:options :components-v2])
|
||||
|
||||
|
||||
@@ -578,7 +578,7 @@
|
||||
(ex/raise :type :conflict
|
||||
:hint "id+name or page should be provided, never both"))
|
||||
(let [page (if (and (string? name) (uuid? id))
|
||||
(ctp/make-empty-page {:id id :name name})
|
||||
(ctp/make-empty-page id name)
|
||||
page)]
|
||||
(ctpl/add-page data page)))
|
||||
|
||||
|
||||
@@ -69,11 +69,6 @@
|
||||
::page page
|
||||
::page-id (:id page)))
|
||||
|
||||
(defn with-page-id
|
||||
[changes page-id]
|
||||
(vary-meta changes assoc
|
||||
::page-id page-id))
|
||||
|
||||
(defn with-container
|
||||
[changes container]
|
||||
(if (cfh/page? container)
|
||||
@@ -720,7 +715,6 @@
|
||||
(map lookupf)
|
||||
(map mk-change))
|
||||
updated-shapes))))
|
||||
|
||||
(apply-changes-local)))))
|
||||
|
||||
(defn update-component
|
||||
@@ -770,6 +764,15 @@
|
||||
(update :undo-changes conj {:type :del-component
|
||||
:id id
|
||||
:main-instance main-instance})))
|
||||
(defn ignore-remote
|
||||
[changes]
|
||||
(letfn [(add-ignore-remote
|
||||
[change-list]
|
||||
(->> change-list
|
||||
(mapv #(assoc % :ignore-remote? true))))]
|
||||
(-> changes
|
||||
(update :redo-changes add-ignore-remote)
|
||||
(update :undo-changes add-ignore-remote))))
|
||||
|
||||
(defn reorder-grid-children
|
||||
[changes ids]
|
||||
|
||||
@@ -6,4 +6,4 @@
|
||||
|
||||
(ns app.common.files.defaults)
|
||||
|
||||
(def version 50)
|
||||
(def version 46)
|
||||
|
||||
103
common/src/app/common/files/libraries_helpers.cljc
Normal file
103
common/src/app/common/files/libraries_helpers.cljc
Normal file
@@ -0,0 +1,103 @@
|
||||
;; 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.files.libraries-helpers
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
(defn generate-add-component-changes
|
||||
[changes root objects file-id page-id components-v2]
|
||||
(let [name (:name root)
|
||||
[path name] (cfh/parse-path-name name)
|
||||
|
||||
[root-shape new-shapes updated-shapes]
|
||||
(if-not components-v2
|
||||
(ctn/make-component-shape root objects file-id components-v2)
|
||||
(ctn/convert-shape-in-component root objects file-id))
|
||||
|
||||
changes (-> changes
|
||||
(pcb/add-component (:id root-shape)
|
||||
path
|
||||
name
|
||||
new-shapes
|
||||
updated-shapes
|
||||
(:id root)
|
||||
page-id))]
|
||||
[root-shape changes]))
|
||||
|
||||
(defn generate-add-component
|
||||
"If there is exactly one id, and it's a frame (or a group in v1), and not already a component,
|
||||
use it as root. Otherwise, create a frame (v2) or group (v1) that contains all ids. Then, make a
|
||||
component with it, and link all shapes to their corresponding one in the component."
|
||||
[it shapes objects page-id file-id components-v2 prepare-create-group prepare-create-board]
|
||||
|
||||
(let [changes (pcb/empty-changes it page-id)
|
||||
shapes-count (count shapes)
|
||||
first-shape (first shapes)
|
||||
|
||||
from-singe-frame?
|
||||
(and (= 1 shapes-count)
|
||||
(cfh/frame-shape? first-shape))
|
||||
|
||||
[root changes old-root-ids]
|
||||
(if (and (= shapes-count 1)
|
||||
(or (and (cfh/group-shape? first-shape)
|
||||
(not components-v2))
|
||||
(cfh/frame-shape? first-shape))
|
||||
(not (ctk/instance-head? first-shape)))
|
||||
[first-shape
|
||||
(-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects))
|
||||
(:shapes first-shape)]
|
||||
|
||||
(let [root-name (if (= 1 shapes-count)
|
||||
(:name first-shape)
|
||||
"Component 1")
|
||||
|
||||
shape-ids (into (d/ordered-set) (map :id) shapes)
|
||||
|
||||
[root changes]
|
||||
(if-not components-v2
|
||||
(prepare-create-group it ; These functions needs to be passed as argument
|
||||
objects ; to avoid a circular dependence
|
||||
page-id
|
||||
shapes
|
||||
root-name
|
||||
(not (ctk/instance-head? first-shape)))
|
||||
(prepare-create-board changes
|
||||
(uuid/next)
|
||||
(:parent-id first-shape)
|
||||
objects
|
||||
shape-ids
|
||||
nil
|
||||
root-name
|
||||
true))]
|
||||
|
||||
[root changes shape-ids]))
|
||||
|
||||
changes
|
||||
(cond-> changes
|
||||
(not from-singe-frame?)
|
||||
(pcb/update-shapes
|
||||
(:shapes root)
|
||||
(fn [shape]
|
||||
(assoc shape :constraints-h :scale :constraints-v :scale))))
|
||||
|
||||
objects' (assoc objects (:id root) root)
|
||||
|
||||
[root-shape changes] (generate-add-component-changes changes root objects' file-id page-id components-v2)
|
||||
|
||||
changes (pcb/update-shapes changes
|
||||
old-root-ids
|
||||
#(dissoc % :component-root)
|
||||
[:component-root])]
|
||||
|
||||
[root (:id root-shape) changes]))
|
||||
@@ -22,8 +22,6 @@
|
||||
[app.common.schema :as sm]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.text :as txt]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
[app.common.uuid :as uuid]
|
||||
@@ -900,111 +898,6 @@
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
|
||||
(defn migrate-up-47
|
||||
[data]
|
||||
(letfn [(fix-shape [page shape]
|
||||
(let [file {:id (:id data) :data data}
|
||||
component-file (:component-file shape)
|
||||
;; On cloning a file, the component-file of the shapes point to the old file id
|
||||
;; this is a workaround to be able to found the components in that case
|
||||
libraries {component-file {:id component-file :data data}}
|
||||
ref-shape (ctf/find-ref-shape file page libraries shape {:include-deleted? true :with-context? true})
|
||||
ref-parent (get (:objects (:container (meta ref-shape))) (:parent-id ref-shape))
|
||||
shape-swap-slot (ctk/get-swap-slot shape)
|
||||
ref-swap-slot (ctk/get-swap-slot ref-shape)]
|
||||
(if (and (some? shape-swap-slot)
|
||||
(= shape-swap-slot ref-swap-slot)
|
||||
(ctk/main-instance? ref-parent))
|
||||
(ctk/remove-swap-slot shape)
|
||||
shape)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals (partial fix-shape page)))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-page))))
|
||||
|
||||
(defn migrate-up-48
|
||||
[data]
|
||||
(letfn [(fix-shape [shape]
|
||||
(let [swap-slot (ctk/get-swap-slot shape)]
|
||||
(if (and (some? swap-slot)
|
||||
(not (ctk/subcopy-head? shape)))
|
||||
(ctk/remove-swap-slot shape)
|
||||
shape)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals fix-shape))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-page))))
|
||||
|
||||
(defn migrate-up-49
|
||||
"Remove hide-in-viewer for shapes that are origin or destination of an interaction"
|
||||
[data]
|
||||
(letfn [(update-object [destinations object]
|
||||
(cond-> object
|
||||
(or (:interactions object)
|
||||
(contains? destinations (:id object)))
|
||||
(dissoc object :hide-in-viewer)))
|
||||
|
||||
(update-page [page]
|
||||
(let [destinations (->> page
|
||||
:objects
|
||||
(vals)
|
||||
(mapcat :interactions)
|
||||
(map :destination)
|
||||
(set))]
|
||||
(update page :objects update-vals (partial update-object destinations))))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
|
||||
(defn migrate-up-50
|
||||
"This migration mainly fixes paths with curve-to segments
|
||||
without :c1x :c1y :c2x :c2y properties. Additionally, we found a
|
||||
case where the params instead to be plain hash-map, is a points
|
||||
instance. This migration normalizes all params to plain map."
|
||||
|
||||
[data]
|
||||
(let [update-segment
|
||||
(fn [{:keys [command params] :as segment}]
|
||||
(let [params (into {} params)
|
||||
params (cond
|
||||
(= :curve-to command)
|
||||
(let [x (get params :x)
|
||||
y (get params :y)]
|
||||
|
||||
(cond-> params
|
||||
(nil? (:c1x params))
|
||||
(assoc :c1x x)
|
||||
|
||||
(nil? (:c1y params))
|
||||
(assoc :c1y y)
|
||||
|
||||
(nil? (:c2x params))
|
||||
(assoc :c2x x)
|
||||
|
||||
(nil? (:c2y params))
|
||||
(assoc :c2y y)))
|
||||
|
||||
:else
|
||||
params)]
|
||||
|
||||
(assoc segment :params params)))
|
||||
|
||||
update-shape
|
||||
(fn [shape]
|
||||
(if (cfh/path-shape? shape)
|
||||
(d/update-when shape :content (fn [content] (mapv update-segment content)))
|
||||
shape))
|
||||
|
||||
update-container
|
||||
(fn [page]
|
||||
(d/update-when page :objects update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
|
||||
|
||||
(def migrations
|
||||
"A vector of all applicable migrations"
|
||||
[{:id 2 :migrate-up migrate-up-2}
|
||||
@@ -1042,8 +935,4 @@
|
||||
{:id 43 :migrate-up migrate-up-43}
|
||||
{:id 44 :migrate-up migrate-up-44}
|
||||
{:id 45 :migrate-up migrate-up-45}
|
||||
{:id 46 :migrate-up migrate-up-46}
|
||||
{:id 47 :migrate-up migrate-up-47}
|
||||
{:id 48 :migrate-up migrate-up-48}
|
||||
{:id 49 :migrate-up migrate-up-49}
|
||||
{:id 50 :migrate-up migrate-up-50}])
|
||||
{:id 46 :migrate-up migrate-up-46}])
|
||||
|
||||
@@ -460,87 +460,6 @@
|
||||
(pcb/with-library-data file-data)
|
||||
(pcb/update-component (:id shape) repair-component))))
|
||||
|
||||
(defmethod repair-error :misplaced-slot
|
||||
[_ {:keys [shape page-id] :as error} file-data _]
|
||||
(let [repair-shape
|
||||
(fn [shape]
|
||||
;; Remove the swap slot
|
||||
(log/debug :hint (str " -> remove swap-slot"))
|
||||
(ctk/remove-swap-slot shape))]
|
||||
|
||||
(log/dbg :hint "repairing shape :misplaced-slot" :id (:id shape) :name (:name shape) :page-id page-id)
|
||||
(-> (pcb/empty-changes nil page-id)
|
||||
(pcb/with-file-data file-data)
|
||||
(pcb/update-shapes [(:id shape)] repair-shape))))
|
||||
|
||||
(defmethod repair-error :duplicate-slot
|
||||
[_ {:keys [shape page-id] :as error} file-data _]
|
||||
(let [page (ctpl/get-page file-data page-id)
|
||||
childs (map #(get (:objects page) %) (:shapes shape))
|
||||
child-with-duplicate (let [result (reduce (fn [[seen duplicates] item]
|
||||
(let [swap-slot (ctk/get-swap-slot item)]
|
||||
(if (contains? seen swap-slot)
|
||||
[seen (conj duplicates item)]
|
||||
[(conj seen swap-slot) duplicates])))
|
||||
[#{} []]
|
||||
childs)]
|
||||
(second result))
|
||||
repair-shape
|
||||
(fn [shape]
|
||||
;; Remove the swap slot
|
||||
(log/debug :hint " -> remove swap-slot" :child-id (:id shape))
|
||||
(ctk/remove-swap-slot shape))]
|
||||
|
||||
(log/dbg :hint "repairing shape :duplicated-slot" :id (:id shape) :name (:name shape) :page-id page-id)
|
||||
(-> (pcb/empty-changes nil page-id)
|
||||
(pcb/with-file-data file-data)
|
||||
(pcb/update-shapes (map :id child-with-duplicate) repair-shape))))
|
||||
|
||||
|
||||
|
||||
(defmethod repair-error :component-duplicate-slot
|
||||
[_ {:keys [shape] :as error} file-data _]
|
||||
(let [main-shape (get-in shape [:objects (:main-instance-id shape)])
|
||||
childs (map #(get (:objects shape) %) (:shapes main-shape))
|
||||
childs-with-duplicate (let [result (reduce (fn [[seen duplicates] item]
|
||||
(let [swap-slot (ctk/get-swap-slot item)]
|
||||
(if (contains? seen swap-slot)
|
||||
[seen (conj duplicates item)]
|
||||
[(conj seen swap-slot) duplicates])))
|
||||
[#{} []]
|
||||
childs)]
|
||||
(second result))
|
||||
duplicated-ids (set (mapv :id childs-with-duplicate))
|
||||
repair-component
|
||||
(fn [component]
|
||||
(let [objects (reduce-kv (fn [acc k v]
|
||||
(if (contains? duplicated-ids k)
|
||||
(assoc acc k (ctk/remove-swap-slot v))
|
||||
(assoc acc k v)))
|
||||
{}
|
||||
(:objects component))]
|
||||
(assoc component :objects objects)))]
|
||||
|
||||
(log/dbg :hint "repairing component :component-duplicated-slot" :id (:id shape) :name (:name shape))
|
||||
(-> (pcb/empty-changes nil)
|
||||
(pcb/with-library-data file-data)
|
||||
(pcb/update-component (:id shape) repair-component))))
|
||||
|
||||
(defmethod repair-error :missing-slot
|
||||
[_ {:keys [shape page-id args] :as error} file-data _]
|
||||
(let [repair-shape
|
||||
(fn [shape]
|
||||
;; Set the desired swap slot
|
||||
(let [slot (:swap-slot args)]
|
||||
(when (some? slot)
|
||||
(log/debug :hint (str " -> set swap-slot to " slot))
|
||||
(ctk/set-swap-slot shape slot))))]
|
||||
|
||||
(log/dbg :hint "repairing shape :missing-slot" :id (:id shape) :name (:name shape) :page-id page-id)
|
||||
(-> (pcb/empty-changes nil page-id)
|
||||
(pcb/with-file-data file-data)
|
||||
(pcb/update-shapes [(:id shape)] repair-shape))))
|
||||
|
||||
(defmethod repair-error :default
|
||||
[_ error file _]
|
||||
(log/error :hint "Unknown error code, don't know how to repair" :code (:code error))
|
||||
|
||||
@@ -6,7 +6,6 @@
|
||||
|
||||
(ns app.common.files.validate
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.helpers :as cfh]
|
||||
@@ -31,11 +30,9 @@
|
||||
:child-not-found
|
||||
:frame-not-found
|
||||
:invalid-frame
|
||||
:component-duplicate-slot
|
||||
:component-not-main
|
||||
:component-main-external
|
||||
:component-not-found
|
||||
:duplicate-slot
|
||||
:invalid-main-instance-id
|
||||
:invalid-main-instance-page
|
||||
:invalid-main-instance
|
||||
@@ -53,9 +50,7 @@
|
||||
:not-head-copy-not-allowed
|
||||
:not-component-not-allowed
|
||||
:component-nil-objects-not-allowed
|
||||
:instance-head-not-frame
|
||||
:misplaced-slot
|
||||
:missing-slot})
|
||||
:instance-head-not-frame})
|
||||
|
||||
(def ^:private
|
||||
schema:error
|
||||
@@ -66,7 +61,7 @@
|
||||
[:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken
|
||||
[:shape-id {:optional true} ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:page-id {:optional true} [:maybe ::sm/uuid]]]))
|
||||
[:page-id ::sm/uuid]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ERROR HANDLING
|
||||
@@ -290,30 +285,6 @@
|
||||
"Shape inside main instance should not have shape-ref"
|
||||
shape file page)))
|
||||
|
||||
(defn- check-empty-swap-slot
|
||||
"Validate that this shape does not have any swap slot."
|
||||
[shape file page]
|
||||
(when (some? (ctk/get-swap-slot shape))
|
||||
(report-error :misplaced-slot
|
||||
"This shape should not have swap slot"
|
||||
shape file page)))
|
||||
|
||||
(defn- has-duplicate-swap-slot?
|
||||
[shape container]
|
||||
(let [shapes (map #(get (:objects container) %) (:shapes shape))
|
||||
slots (->> (map #(ctk/get-swap-slot %) shapes)
|
||||
(remove nil?))
|
||||
counts (frequencies slots)]
|
||||
(some (fn [[_ count]] (> count 1)) counts)))
|
||||
|
||||
(defn- check-duplicate-swap-slot
|
||||
"Validate that the children of this shape does not have duplicated slots."
|
||||
[shape file page]
|
||||
(when (has-duplicate-swap-slot? shape page)
|
||||
(report-error :duplicate-slot
|
||||
"This shape has children with the same swap slot"
|
||||
shape file page)))
|
||||
|
||||
(defn- check-shape-main-root-top
|
||||
"Root shape of a top main instance:
|
||||
|
||||
@@ -325,8 +296,6 @@
|
||||
(check-component-main-head shape file page libraries)
|
||||
(check-component-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(check-duplicate-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :main-top) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-main-root-nested
|
||||
@@ -338,7 +307,6 @@
|
||||
(check-component-main-head shape file page libraries)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :main-nested) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-copy-root-top
|
||||
@@ -353,8 +321,6 @@
|
||||
(check-component-not-main-head shape file page libraries)
|
||||
(check-component-root shape file page)
|
||||
(check-component-ref shape file page libraries)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(check-duplicate-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :copy-top :library-exists library-exists) (:shapes shape))))
|
||||
|
||||
(defn- check-shape-copy-root-nested
|
||||
@@ -377,7 +343,6 @@
|
||||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :main-any) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-copy-not-root
|
||||
@@ -386,7 +351,6 @@
|
||||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-ref shape file page libraries)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :copy-any) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-not-component
|
||||
@@ -396,7 +360,6 @@
|
||||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(check-empty-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :not-component) (:shapes shape)))
|
||||
|
||||
(defn- check-shape
|
||||
@@ -473,24 +436,13 @@
|
||||
shape file page)
|
||||
(check-shape-not-component shape file page libraries))))))))
|
||||
|
||||
(defn check-component-duplicate-swap-slot
|
||||
[component file]
|
||||
(let [shape (get-in component [:objects (:main-instance-id component)])]
|
||||
(when (has-duplicate-swap-slot? shape component)
|
||||
(report-error :component-duplicate-slot
|
||||
"This deleted component has children with the same swap slot"
|
||||
component file nil))))
|
||||
|
||||
|
||||
(defn- check-component
|
||||
"Validate semantic coherence of a component. Report all errors found."
|
||||
[component file]
|
||||
(when (and (contains? component :objects) (nil? (:objects component)))
|
||||
(report-error :component-nil-objects-not-allowed
|
||||
"Objects list cannot be nil"
|
||||
component file nil))
|
||||
(when (:deleted component)
|
||||
(check-component-duplicate-swap-slot component file)))
|
||||
component file nil)))
|
||||
|
||||
(defn- get-orphan-shapes
|
||||
[{:keys [objects] :as page}]
|
||||
@@ -502,8 +454,6 @@
|
||||
;; PUBLIC API: VALIDATION FUNCTIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare check-swap-slots)
|
||||
|
||||
(defn validate-file
|
||||
"Validate full referential integrity and semantic coherence on file data.
|
||||
|
||||
@@ -514,8 +464,6 @@
|
||||
|
||||
(doseq [page (filter :id (ctpl/pages-seq data))]
|
||||
(check-shape uuid/zero file page libraries)
|
||||
(when (str/includes? (:name file) "check-swap-slot")
|
||||
(check-swap-slots uuid/zero file page libraries))
|
||||
(->> (get-orphan-shapes page)
|
||||
(run! #(check-shape % file page libraries))))
|
||||
|
||||
@@ -569,41 +517,3 @@
|
||||
:hint "error on validating file referential integrity"
|
||||
:file-id (:id file)
|
||||
:details errors)))
|
||||
|
||||
|
||||
(declare compare-slots)
|
||||
|
||||
;; Optional check to look for missing swap slots.
|
||||
;; Search for copies that do not point the shape-ref to the near component but don't have swap slot
|
||||
;; (looking for position relative to the parent, in the copy and the main).
|
||||
;;
|
||||
;; This check cannot be generally enabled, because files that have been migrated from components v1
|
||||
;; may have copies with shapes that do not match by position, but have not been swapped. So we enable
|
||||
;; it for specific files only. To activate the check, you need to add the string "check-swap-slot" to
|
||||
;; the name of the file.
|
||||
(defn- check-swap-slots
|
||||
[shape-id file page libraries]
|
||||
(let [shape (ctst/get-shape page shape-id)]
|
||||
(if (and (ctk/instance-root? shape) (ctk/in-component-copy? shape))
|
||||
(let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true :with-context? true)
|
||||
container (:container (meta ref-shape))]
|
||||
(when (some? ref-shape)
|
||||
(compare-slots shape ref-shape file page container)))
|
||||
(doall (for [child-id (:shapes shape)]
|
||||
(check-swap-slots child-id file page libraries))))))
|
||||
|
||||
(defn- compare-slots
|
||||
[shape-copy shape-main file container-copy container-main]
|
||||
(if (and (not= (:shape-ref shape-copy) (:id shape-main))
|
||||
(nil? (ctk/get-swap-slot shape-copy)))
|
||||
(report-error :missing-slot
|
||||
"Shape has been swapped, should have swap slot"
|
||||
shape-copy file container-copy
|
||||
:swap-slot (or (ctk/get-swap-slot shape-main) (:id shape-main)))
|
||||
(when (nil? (ctk/get-swap-slot shape-copy))
|
||||
(let [children-id-pairs (d/zip-all (:shapes shape-copy) (:shapes shape-main))]
|
||||
(doall (for [[child-copy-id child-main-id] children-id-pairs]
|
||||
(let [child-copy (ctst/get-shape container-copy child-copy-id)
|
||||
child-main (ctst/get-shape container-main child-main-id)]
|
||||
(when (and (some? child-copy) (some? child-main))
|
||||
(compare-slots child-copy child-main file container-copy container-main)))))))))
|
||||
|
||||
@@ -269,13 +269,6 @@
|
||||
(keep (mk-check-auto-layout objects))
|
||||
shapes)))
|
||||
|
||||
(defn full-tree?
|
||||
"Checks if we need to calculate the full tree or we can calculate just a partial tree. Partial
|
||||
trees are more efficient but cannot be done when the layout is centered."
|
||||
[objects layout-id]
|
||||
(let [layout-justify-content (get-in objects [layout-id :layout-justify-content])]
|
||||
(contains? #{:center :end :space-around :space-evenly :stretch} layout-justify-content)))
|
||||
|
||||
(defn sizing-auto-modifiers
|
||||
"Recalculates the layouts to adjust the sizing: auto new sizes"
|
||||
[modif-tree sizing-auto-layouts objects bounds ignore-constraints]
|
||||
@@ -293,7 +286,7 @@
|
||||
(d/seek sizing-auto-layouts))
|
||||
|
||||
shapes
|
||||
(if (and from-layout (not (full-tree? objects from-layout)))
|
||||
(if from-layout
|
||||
(cgst/resolve-subtree from-layout layout-id objects)
|
||||
(cgst/resolve-tree #{layout-id} objects))
|
||||
|
||||
|
||||
@@ -1,532 +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.logic.shapes
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
(defn generate-update-shapes
|
||||
[changes ids update-fn objects {:keys [attrs ignore-tree ignore-touched with-objects?]}]
|
||||
(let [changes (reduce
|
||||
(fn [changes id]
|
||||
(let [opts {:attrs attrs
|
||||
:ignore-geometry? (get ignore-tree id)
|
||||
:ignore-touched ignore-touched
|
||||
:with-objects? with-objects?}]
|
||||
(pcb/update-shapes changes [id] update-fn (d/without-nils opts))))
|
||||
(-> changes
|
||||
(pcb/with-objects objects))
|
||||
ids)
|
||||
grid-ids (->> ids (filter (partial ctl/grid-layout? objects)))
|
||||
changes (pcb/update-shapes changes grid-ids ctl/assign-cell-positions {:with-objects? true})
|
||||
changes (pcb/reorder-grid-children changes ids)]
|
||||
changes))
|
||||
|
||||
(defn- generate-update-shape-flags
|
||||
[changes ids objects {:keys [blocked hidden] :as flags}]
|
||||
(let [update-fn
|
||||
(fn [obj]
|
||||
(cond-> obj
|
||||
(boolean? blocked) (assoc :blocked blocked)
|
||||
(boolean? hidden) (assoc :hidden hidden)))
|
||||
|
||||
ids (if (boolean? blocked)
|
||||
(into ids (->> ids (mapcat #(cfh/get-children-ids objects %))))
|
||||
ids)]
|
||||
(-> changes
|
||||
(pcb/update-shapes ids update-fn {:attrs #{:blocked :hidden}}))))
|
||||
|
||||
(defn generate-delete-shapes
|
||||
[changes file page objects ids {:keys [components-v2 ignore-touched component-swap]}]
|
||||
(let [ids (cfh/clean-loops objects ids)
|
||||
|
||||
in-component-copy?
|
||||
(fn [shape-id]
|
||||
;; Look for shapes that are inside a component copy, but are
|
||||
;; not the root. In this case, they must not be deleted,
|
||||
;; but hidden (to be able to recover them more easily).
|
||||
;; Unless we are doing a component swap, in which case we want
|
||||
;; to delete the old shape
|
||||
(let [shape (get objects shape-id)]
|
||||
(and (ctn/has-any-copy-parent? objects shape)
|
||||
(not component-swap))))
|
||||
|
||||
[ids-to-delete ids-to-hide]
|
||||
(if components-v2
|
||||
(loop [ids-seq (seq ids)
|
||||
ids-to-delete []
|
||||
ids-to-hide []]
|
||||
(let [id (first ids-seq)]
|
||||
(if (nil? id)
|
||||
[ids-to-delete ids-to-hide]
|
||||
(if (in-component-copy? id)
|
||||
(recur (rest ids-seq)
|
||||
ids-to-delete
|
||||
(conj ids-to-hide id))
|
||||
(recur (rest ids-seq)
|
||||
(conj ids-to-delete id)
|
||||
ids-to-hide)))))
|
||||
[ids []])
|
||||
|
||||
changes (-> changes
|
||||
(pcb/with-page page)
|
||||
(pcb/with-objects objects)
|
||||
(pcb/with-library-data file))
|
||||
lookup (d/getf objects)
|
||||
groups-to-unmask
|
||||
(reduce (fn [group-ids id]
|
||||
;; When the shape to delete is the mask of a masked group,
|
||||
;; the mask condition must be removed, and it must be
|
||||
;; converted to a normal group.
|
||||
(let [obj (lookup id)
|
||||
parent (lookup (:parent-id obj))]
|
||||
(if (and (:masked-group parent)
|
||||
(= id (first (:shapes parent))))
|
||||
(conj group-ids (:id parent))
|
||||
group-ids)))
|
||||
#{}
|
||||
ids-to-delete)
|
||||
|
||||
interacting-shapes
|
||||
(filter (fn [shape]
|
||||
;; If any of the deleted shapes is the destination of
|
||||
;; some interaction, this must be deleted, too.
|
||||
(let [interactions (:interactions shape)]
|
||||
(some #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %)))
|
||||
interactions)))
|
||||
(vals objects))
|
||||
|
||||
ids-set (set ids-to-delete)
|
||||
guides-to-remove
|
||||
(->> (dm/get-in page [:options :guides])
|
||||
(vals)
|
||||
(filter #(contains? ids-set (:frame-id %)))
|
||||
(map :id))
|
||||
|
||||
guides
|
||||
(->> guides-to-remove
|
||||
(reduce dissoc (dm/get-in page [:options :guides])))
|
||||
|
||||
starting-flows
|
||||
(filter (fn [flow]
|
||||
;; If any of the deleted is a frame that starts a flow,
|
||||
;; this must be deleted, too.
|
||||
(contains? ids-to-delete (:starting-frame flow)))
|
||||
(-> page :options :flows))
|
||||
|
||||
all-parents
|
||||
(reduce (fn [res id]
|
||||
;; All parents of any deleted shape must be resized.
|
||||
(into res (cfh/get-parent-ids objects id)))
|
||||
(d/ordered-set)
|
||||
ids-to-delete)
|
||||
|
||||
all-children
|
||||
(->> ids-to-delete ;; Children of deleted shapes must be also deleted.
|
||||
(reduce (fn [res id]
|
||||
(into res (cfh/get-children-ids objects id)))
|
||||
[])
|
||||
(reverse)
|
||||
(into (d/ordered-set)))
|
||||
|
||||
find-all-empty-parents
|
||||
(fn recursive-find-empty-parents [empty-parents]
|
||||
(let [all-ids (into empty-parents ids-to-delete)
|
||||
contains? (partial contains? all-ids)
|
||||
xform (comp (map lookup)
|
||||
(filter #(or (cfh/group-shape? %) (cfh/bool-shape? %)))
|
||||
(remove #(->> (:shapes %) (remove contains?) seq))
|
||||
(map :id))
|
||||
parents (into #{} xform all-parents)]
|
||||
(if (= empty-parents parents)
|
||||
empty-parents
|
||||
(recursive-find-empty-parents parents))))
|
||||
|
||||
empty-parents
|
||||
;; Any parent whose children are all deleted, must be deleted too.
|
||||
(into (d/ordered-set) (find-all-empty-parents #{}))
|
||||
|
||||
components-to-delete
|
||||
(if components-v2
|
||||
(reduce (fn [components id]
|
||||
(let [shape (get objects id)]
|
||||
(if (and (= (:component-file shape) (:id file)) ;; Main instances should exist only in local file
|
||||
(:main-instance shape)) ;; but check anyway
|
||||
(conj components (:component-id shape))
|
||||
components)))
|
||||
[]
|
||||
(into ids-to-delete all-children))
|
||||
[])
|
||||
|
||||
changes (-> changes
|
||||
(pcb/set-page-option :guides guides))
|
||||
|
||||
changes (reduce (fn [changes component-id]
|
||||
;; It's important to delete the component before the main instance, because we
|
||||
;; need to store the instance position if we want to restore it later.
|
||||
(pcb/delete-component changes component-id (:id page)))
|
||||
changes
|
||||
components-to-delete)
|
||||
changes (-> changes
|
||||
(generate-update-shape-flags ids-to-hide objects {:hidden true})
|
||||
(pcb/remove-objects all-children {:ignore-touched true})
|
||||
(pcb/remove-objects ids-to-delete {:ignore-touched ignore-touched})
|
||||
(pcb/remove-objects empty-parents)
|
||||
(pcb/resize-parents all-parents)
|
||||
(pcb/update-shapes groups-to-unmask
|
||||
(fn [shape]
|
||||
(assoc shape :masked-group false)))
|
||||
(pcb/update-shapes (map :id interacting-shapes)
|
||||
(fn [shape]
|
||||
(d/update-when shape :interactions
|
||||
(fn [interactions]
|
||||
(into []
|
||||
(remove #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %))))
|
||||
interactions)))))
|
||||
(cond-> (seq starting-flows)
|
||||
(pcb/update-page-option :flows (fn [flows]
|
||||
(->> (map :id starting-flows)
|
||||
(reduce ctp/remove-flow flows))))))]
|
||||
[all-parents changes]))
|
||||
|
||||
(defn generate-relocate-shapes [changes objects parents parent-id page-id to-index ids]
|
||||
(let [groups-to-delete
|
||||
(loop [current-id (first parents)
|
||||
to-check (rest parents)
|
||||
removed-id? (set ids)
|
||||
result #{}]
|
||||
|
||||
(if-not current-id
|
||||
;; Base case, no next element
|
||||
result
|
||||
|
||||
(let [group (get objects current-id)]
|
||||
(if (and (not= :frame (:type group))
|
||||
(not= current-id parent-id)
|
||||
(empty? (remove removed-id? (:shapes group))))
|
||||
|
||||
;; Adds group to the remove and check its parent
|
||||
(let [to-check (concat to-check [(cfh/get-parent-id objects current-id)])]
|
||||
(recur (first to-check)
|
||||
(rest to-check)
|
||||
(conj removed-id? current-id)
|
||||
(conj result current-id)))
|
||||
|
||||
;; otherwise recur
|
||||
(recur (first to-check)
|
||||
(rest to-check)
|
||||
removed-id?
|
||||
result)))))
|
||||
|
||||
groups-to-unmask
|
||||
(reduce (fn [group-ids id]
|
||||
;; When a masked group loses its mask shape, because it's
|
||||
;; moved outside the group, the mask condition must be
|
||||
;; removed, and it must be converted to a normal group.
|
||||
(let [obj (get objects id)
|
||||
parent (get objects (:parent-id obj))]
|
||||
(if (and (:masked-group parent)
|
||||
(= id (first (:shapes parent)))
|
||||
(not= (:id parent) parent-id))
|
||||
(conj group-ids (:id parent))
|
||||
group-ids)))
|
||||
#{}
|
||||
ids)
|
||||
|
||||
|
||||
;; TODO: Probably implementing this using loop/recur will
|
||||
;; be more efficient than using reduce and continuous data
|
||||
;; desturcturing.
|
||||
|
||||
;; Sets the correct components metadata for the moved shapes
|
||||
;; `shapes-to-detach` Detach from a component instance a shape that was inside a component and is moved outside
|
||||
;; `shapes-to-deroot` Removes the root flag from a component instance moved inside another component
|
||||
;; `shapes-to-reroot` Adds a root flag when a nested component instance is moved outside
|
||||
[shapes-to-detach shapes-to-deroot shapes-to-reroot]
|
||||
(reduce (fn [[shapes-to-detach shapes-to-deroot shapes-to-reroot] id]
|
||||
(let [shape (get objects id)
|
||||
parent (get objects parent-id)
|
||||
component-shape (ctn/get-component-shape objects shape)
|
||||
component-shape-parent (ctn/get-component-shape objects parent {:allow-main? true})
|
||||
root-parent (ctn/get-instance-root objects parent)
|
||||
|
||||
detach? (and (ctk/in-component-copy-not-head? shape)
|
||||
(not= (:id component-shape)
|
||||
(:id component-shape-parent)))
|
||||
deroot? (and (ctk/instance-root? shape)
|
||||
root-parent)
|
||||
reroot? (and (ctk/subinstance-head? shape)
|
||||
(not component-shape-parent))
|
||||
|
||||
ids-to-detach (when detach?
|
||||
(cons id (cfh/get-children-ids objects id)))]
|
||||
|
||||
[(cond-> shapes-to-detach detach? (into ids-to-detach))
|
||||
(cond-> shapes-to-deroot deroot? (conj id))
|
||||
(cond-> shapes-to-reroot reroot? (conj id))]))
|
||||
[[] [] []]
|
||||
(->> ids
|
||||
(mapcat #(ctn/get-child-heads objects %))
|
||||
(map :id)))
|
||||
|
||||
shapes-to-unconstraint ids
|
||||
|
||||
ordered-indexes (cfh/order-by-indexed-shapes objects ids)
|
||||
shapes (map (d/getf objects) ordered-indexes)
|
||||
parent (get objects parent-id)
|
||||
component-main-parent (ctn/find-component-main objects parent false)
|
||||
child-heads
|
||||
(->> ordered-indexes
|
||||
(mapcat #(ctn/get-child-heads objects %))
|
||||
(map :id))]
|
||||
|
||||
(-> changes
|
||||
(pcb/with-page-id page-id)
|
||||
(pcb/with-objects objects)
|
||||
|
||||
;; Remove layout-item properties when moving a shape outside a layout
|
||||
(cond-> (not (ctl/any-layout? parent))
|
||||
(pcb/update-shapes ordered-indexes ctl/remove-layout-item-data))
|
||||
|
||||
;; Remove the hide in viewer flag
|
||||
(cond-> (and (not= uuid/zero parent-id) (cfh/frame-shape? parent))
|
||||
(pcb/update-shapes ordered-indexes #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true))))
|
||||
|
||||
;; Remove the swap slots if it is moving to a different component
|
||||
(pcb/update-shapes child-heads
|
||||
(fn [shape]
|
||||
(cond-> shape
|
||||
(not= component-main-parent (ctn/find-component-main objects shape false))
|
||||
(ctk/remove-swap-slot))))
|
||||
|
||||
;; Add component-root property when moving a component outside a component
|
||||
(cond-> (not (ctn/get-instance-root objects parent))
|
||||
(pcb/update-shapes child-heads #(assoc % :component-root true)))
|
||||
|
||||
;; Move the shapes
|
||||
(pcb/change-parent parent-id
|
||||
shapes
|
||||
to-index)
|
||||
|
||||
;; Remove empty groups
|
||||
(pcb/remove-objects groups-to-delete)
|
||||
|
||||
;; Unmask groups whose mask have moved outside
|
||||
(pcb/update-shapes groups-to-unmask
|
||||
(fn [shape]
|
||||
(assoc shape :masked-group false)))
|
||||
|
||||
;; Detach shapes moved out of their component
|
||||
(pcb/update-shapes shapes-to-detach ctk/detach-shape)
|
||||
|
||||
;; Make non root a component moved inside another one
|
||||
(pcb/update-shapes shapes-to-deroot
|
||||
(fn [shape]
|
||||
(assoc shape :component-root nil)))
|
||||
|
||||
;; Make root a subcomponent moved outside its parent component
|
||||
(pcb/update-shapes shapes-to-reroot
|
||||
(fn [shape]
|
||||
(assoc shape :component-root true)))
|
||||
|
||||
;; Reset constraints depending on the new parent
|
||||
(pcb/update-shapes shapes-to-unconstraint
|
||||
(fn [shape]
|
||||
(let [frame-id (if (= (:type parent) :frame)
|
||||
(:id parent)
|
||||
(:frame-id parent))
|
||||
moved-shape (assoc shape
|
||||
:parent-id parent-id
|
||||
:frame-id frame-id)]
|
||||
(assoc shape
|
||||
:constraints-h (gsh/default-constraints-h moved-shape)
|
||||
:constraints-v (gsh/default-constraints-v moved-shape))))
|
||||
{:ignore-touched true})
|
||||
|
||||
;; Fix the sizing when moving a shape
|
||||
(pcb/update-shapes parents
|
||||
(fn [parent]
|
||||
(if (ctl/flex-layout? parent)
|
||||
(cond-> parent
|
||||
(ctl/change-h-sizing? (:id parent) objects (:shapes parent))
|
||||
(assoc :layout-item-h-sizing :fix)
|
||||
|
||||
(ctl/change-v-sizing? (:id parent) objects (:shapes parent))
|
||||
(assoc :layout-item-v-sizing :fix))
|
||||
parent)))
|
||||
|
||||
;; Update grid layout
|
||||
(cond-> (ctl/grid-layout? objects parent-id)
|
||||
(pcb/update-shapes [parent-id] #(ctl/add-children-to-index % ids objects to-index)))
|
||||
|
||||
(pcb/update-shapes parents
|
||||
(fn [parent objects]
|
||||
(cond-> parent
|
||||
(ctl/grid-layout? parent)
|
||||
(ctl/assign-cells objects)))
|
||||
{:with-objects? true})
|
||||
|
||||
(pcb/reorder-grid-children parents)
|
||||
|
||||
;; If parent locked, lock the added shapes
|
||||
(cond-> (:blocked parent)
|
||||
(pcb/update-shapes ordered-indexes #(assoc % :blocked true)))
|
||||
|
||||
;; Resize parent containers that need to
|
||||
(pcb/resize-parents parents))))
|
||||
|
||||
|
||||
(defn generate-move-shapes-to-frame
|
||||
[changes ids frame-id page-id objects drop-index [row column :as cell]]
|
||||
(let [lookup (d/getf objects)
|
||||
frame (get objects frame-id)
|
||||
layout? (:layout frame)
|
||||
|
||||
component-main-frame (ctn/find-component-main objects frame false)
|
||||
|
||||
shapes (->> ids
|
||||
(cfh/clean-loops objects)
|
||||
(keep lookup)
|
||||
;;remove shapes inside copies, because we can't change the structure of copies
|
||||
(remove #(ctk/in-component-copy? (get objects (:parent-id %)))))
|
||||
|
||||
moving-shapes
|
||||
(cond->> shapes
|
||||
(not layout?)
|
||||
(remove #(= (:frame-id %) frame-id))
|
||||
|
||||
layout?
|
||||
(remove #(and (= (:frame-id %) frame-id)
|
||||
(not= (:parent-id %) frame-id))))
|
||||
|
||||
ordered-indexes (cfh/order-by-indexed-shapes objects (map :id moving-shapes))
|
||||
moving-shapes (map (d/getf objects) ordered-indexes)
|
||||
|
||||
all-parents
|
||||
(reduce (fn [res id]
|
||||
(into res (cfh/get-parent-ids objects id)))
|
||||
(d/ordered-set)
|
||||
ids)
|
||||
|
||||
find-all-empty-parents
|
||||
(fn recursive-find-empty-parents [empty-parents]
|
||||
(let [all-ids (into empty-parents ids)
|
||||
contains? (partial contains? all-ids)
|
||||
xform (comp (map lookup)
|
||||
(filter cfh/group-shape?)
|
||||
(remove #(->> (:shapes %) (remove contains?) seq))
|
||||
(map :id))
|
||||
parents (into #{} xform all-parents)]
|
||||
(if (= empty-parents parents)
|
||||
empty-parents
|
||||
(recursive-find-empty-parents parents))))
|
||||
|
||||
empty-parents
|
||||
;; Any empty parent whose children are moved to another frame should be deleted
|
||||
(if (empty? moving-shapes)
|
||||
#{}
|
||||
(into (d/ordered-set) (find-all-empty-parents #{})))
|
||||
|
||||
;; Not move absolute shapes that won't change parent
|
||||
moving-shapes
|
||||
(->> moving-shapes
|
||||
(remove (fn [shape]
|
||||
(and (ctl/position-absolute? shape)
|
||||
(= frame-id (:parent-id shape))))))
|
||||
|
||||
frame-component
|
||||
(ctn/get-component-shape objects frame)
|
||||
|
||||
shape-ids-to-detach
|
||||
(reduce (fn [result shape]
|
||||
(if (and (some? shape) (ctk/in-component-copy-not-head? shape))
|
||||
(let [shape-component (ctn/get-component-shape objects shape)]
|
||||
(if (= (:id frame-component) (:id shape-component))
|
||||
result
|
||||
(into result (cfh/get-children-ids-with-self objects (:id shape)))))
|
||||
result))
|
||||
#{}
|
||||
moving-shapes)
|
||||
|
||||
moving-shapes-ids
|
||||
(map :id moving-shapes)
|
||||
|
||||
moving-shapes-children-ids
|
||||
(->> moving-shapes-ids
|
||||
(mapcat #(cfh/get-children-ids-with-self objects %)))
|
||||
|
||||
child-heads
|
||||
(->> moving-shapes-ids
|
||||
(mapcat #(ctn/get-child-heads objects %))
|
||||
(map :id))]
|
||||
(-> changes
|
||||
(pcb/with-page-id page-id)
|
||||
(pcb/with-objects objects)
|
||||
|
||||
;; Remove layout-item properties when moving a shape outside a layout
|
||||
(cond-> (not (ctl/any-layout? objects frame-id))
|
||||
(pcb/update-shapes moving-shapes-ids ctl/remove-layout-item-data))
|
||||
|
||||
;; Remove the swap slots if it is moving to a different component
|
||||
(pcb/update-shapes
|
||||
child-heads
|
||||
(fn [shape]
|
||||
(cond-> shape
|
||||
(not= component-main-frame (ctn/find-component-main objects shape false))
|
||||
(ctk/remove-swap-slot))))
|
||||
|
||||
;; Remove component-root property when moving a shape inside a component
|
||||
(cond-> (ctn/get-instance-root objects frame)
|
||||
(pcb/update-shapes moving-shapes-children-ids #(dissoc % :component-root)))
|
||||
|
||||
;; Add component-root property when moving a component outside a component
|
||||
(cond-> (not (ctn/get-instance-root objects frame))
|
||||
(pcb/update-shapes child-heads #(assoc % :component-root true)))
|
||||
|
||||
(pcb/update-shapes moving-shapes-ids #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true)))
|
||||
(pcb/update-shapes shape-ids-to-detach ctk/detach-shape)
|
||||
(pcb/change-parent frame-id moving-shapes drop-index)
|
||||
|
||||
;; Change the grid cell in a grid layout
|
||||
(cond-> (ctl/grid-layout? objects frame-id)
|
||||
(-> (pcb/update-shapes
|
||||
[frame-id]
|
||||
(fn [frame objects]
|
||||
(-> frame
|
||||
;; Assign the cell when pushing into a specific grid cell
|
||||
(cond-> (some? cell)
|
||||
(-> (ctl/free-cell-shapes moving-shapes-ids)
|
||||
(ctl/push-into-cell moving-shapes-ids row column)
|
||||
(ctl/assign-cells objects)))
|
||||
(ctl/assign-cell-positions objects)))
|
||||
{:with-objects? true})
|
||||
(pcb/reorder-grid-children [frame-id])))
|
||||
(pcb/remove-objects empty-parents))))
|
||||
|
||||
|
||||
(defn change-show-in-viewer [shape hide?]
|
||||
(cond-> (assoc shape :hide-in-viewer hide?)
|
||||
;; When a frame is no longer shown in view mode, it cannot have interactions
|
||||
hide?
|
||||
(dissoc :interactions)))
|
||||
|
||||
(defn add-new-interaction [shape interaction]
|
||||
(-> shape
|
||||
(update :interactions ctsi/add-interaction interaction)
|
||||
;; When a interaction is created, the frame must be shown in view mode
|
||||
(dissoc :hide-in-viewer)))
|
||||
@@ -429,80 +429,22 @@
|
||||
`(update ~ssym ~ksym ~f ~@params)))
|
||||
|
||||
(defmacro define-properties!
|
||||
"Define properties in the prototype with `.defineProperty`"
|
||||
[rsym & properties]
|
||||
(let [rsym (with-meta rsym {:tag 'js})]
|
||||
`(do
|
||||
~@(for [params properties
|
||||
:let [pname (get params :name)
|
||||
get-fn (get params :get)
|
||||
set-fn (get params :set)
|
||||
enum-p (get params :enumerable)
|
||||
conf-p (get params :configurable)
|
||||
writ-p (get params :writable)]]
|
||||
`(.defineProperty js/Object (.-prototype ~rsym) ~pname
|
||||
set-fn (get params :set)]]
|
||||
`(.defineProperty js/Object
|
||||
(.-prototype ~rsym)
|
||||
~pname
|
||||
(cljs.core/js-obj
|
||||
"enumerable" true
|
||||
"configurable" true
|
||||
~@(concat
|
||||
(if (some? enum-p)
|
||||
["enumerable" enum-p]
|
||||
["enumerable" true])
|
||||
|
||||
(if (some? conf-p)
|
||||
["configurable" conf-p]
|
||||
["configurable" true])
|
||||
|
||||
(when (some? writ-p)
|
||||
["writable" writ-p])
|
||||
|
||||
(when get-fn
|
||||
["get" get-fn])
|
||||
|
||||
(when set-fn
|
||||
["set" set-fn]))))))))
|
||||
|
||||
(defmacro add-properties!
|
||||
"Adds properties to an object using `.defineProperty`"
|
||||
[rsym & properties]
|
||||
(let [rsym (with-meta rsym {:tag 'js})
|
||||
getf-sym (with-meta (gensym "get-fn") {:tag 'js})
|
||||
setf-sym (with-meta (gensym "set-fn") {:tag 'js})
|
||||
this-sym (with-meta (gensym "this") {:tag 'js})
|
||||
target-sym (with-meta (gensym "target") {:tag 'js})]
|
||||
`(let [~target-sym ~rsym]
|
||||
;; Creates the `.defineProperty` per property
|
||||
~@(for [params properties
|
||||
:let [pname (get params :name)
|
||||
get-fn (get params :get)
|
||||
set-fn (get params :set)
|
||||
enum-p (get params :enumerable)
|
||||
conf-p (get params :configurable)
|
||||
writ-p (get params :writable)]]
|
||||
`(let [~getf-sym ~get-fn
|
||||
~setf-sym ~set-fn]
|
||||
(.defineProperty
|
||||
js/Object
|
||||
~target-sym
|
||||
~pname
|
||||
(cljs.core/js-obj
|
||||
~@(concat
|
||||
(if (some? enum-p)
|
||||
["enumerable" enum-p]
|
||||
;; Default in JS is false. We default to true
|
||||
["enumerable" true])
|
||||
|
||||
(when (some? conf-p)
|
||||
["configurable" conf-p])
|
||||
|
||||
(when (some? writ-p)
|
||||
["writable" writ-p])
|
||||
|
||||
(when get-fn
|
||||
["get" `(fn []
|
||||
(cljs.core/this-as ~this-sym
|
||||
(~getf-sym ~this-sym)))])
|
||||
(when set-fn
|
||||
["set" `(fn [value#]
|
||||
(cljs.core/this-as ~this-sym
|
||||
(~setf-sym ~this-sym value#)))]))))))
|
||||
;; Returns the object
|
||||
~target-sym)))
|
||||
|
||||
@@ -1046,6 +1046,7 @@
|
||||
(str/includes? data "<!DOCTYPE")
|
||||
(str/replace #"<\!DOCTYPE[^>]*>" "")))
|
||||
|
||||
|
||||
(defn parse
|
||||
[text]
|
||||
#?(:cljs (tubax/xml->clj text)
|
||||
|
||||
@@ -22,7 +22,6 @@
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def default-rect
|
||||
@@ -79,68 +78,67 @@
|
||||
(declare parse-svg-element)
|
||||
|
||||
(defn create-svg-shapes
|
||||
([svg-data pos objects frame-id parent-id selected center?]
|
||||
(create-svg-shapes (uuid/next) svg-data pos objects frame-id parent-id selected center?))
|
||||
([id svg-data {:keys [x y]} objects frame-id parent-id selected center?]
|
||||
(let [[vb-x vb-y vb-width vb-height] (svg-dimensions svg-data)
|
||||
[svg-data {:keys [x y]} objects frame-id parent-id selected center?]
|
||||
(let [[vb-x vb-y vb-width vb-height] (svg-dimensions svg-data)
|
||||
|
||||
unames (cfh/get-used-names objects)
|
||||
svg-name (str/replace (:name svg-data) ".svg" "")
|
||||
|
||||
svg-data (-> svg-data
|
||||
(assoc :x (mth/round
|
||||
(if center?
|
||||
(- x vb-x (/ vb-width 2))
|
||||
x)))
|
||||
(assoc :y (mth/round
|
||||
(if center?
|
||||
(- y vb-y (/ vb-height 2))
|
||||
y)))
|
||||
(assoc :offset-x vb-x)
|
||||
(assoc :offset-y vb-y)
|
||||
(assoc :width vb-width)
|
||||
(assoc :height vb-height)
|
||||
(assoc :name svg-name))
|
||||
unames (cfh/get-used-names objects)
|
||||
svg-name (str/replace (:name svg-data) ".svg" "")
|
||||
|
||||
[def-nodes svg-data]
|
||||
(-> svg-data
|
||||
(csvg/fix-default-values)
|
||||
(csvg/fix-percents)
|
||||
(csvg/extract-defs))
|
||||
svg-data (-> svg-data
|
||||
(assoc :x (mth/round
|
||||
(if center?
|
||||
(- x vb-x (/ vb-width 2))
|
||||
x)))
|
||||
(assoc :y (mth/round
|
||||
(if center?
|
||||
(- y vb-y (/ vb-height 2))
|
||||
y)))
|
||||
(assoc :offset-x vb-x)
|
||||
(assoc :offset-y vb-y)
|
||||
(assoc :width vb-width)
|
||||
(assoc :height vb-height)
|
||||
(assoc :name svg-name))
|
||||
|
||||
;; In penpot groups have the size of their children. To
|
||||
;; respect the imported svg size and empty space let's create
|
||||
;; a transparent shape as background to respect the imported
|
||||
;; size
|
||||
background
|
||||
{:tag :rect
|
||||
:attrs {:x (dm/str vb-x)
|
||||
:y (dm/str vb-y)
|
||||
:width (dm/str vb-width)
|
||||
:height (dm/str vb-height)
|
||||
:fill "none"
|
||||
:id "base-background"}
|
||||
:hidden true
|
||||
:content []}
|
||||
[def-nodes svg-data]
|
||||
(-> svg-data
|
||||
(csvg/fix-default-values)
|
||||
(csvg/fix-percents)
|
||||
(csvg/extract-defs))
|
||||
|
||||
svg-data (-> svg-data
|
||||
(assoc :defs def-nodes)
|
||||
(assoc :content (into [background] (:content svg-data))))
|
||||
;; In penpot groups have the size of their children. To
|
||||
;; respect the imported svg size and empty space let's create
|
||||
;; a transparent shape as background to respect the imported
|
||||
;; size
|
||||
background
|
||||
{:tag :rect
|
||||
:attrs {:x (dm/str vb-x)
|
||||
:y (dm/str vb-y)
|
||||
:width (dm/str vb-width)
|
||||
:height (dm/str vb-height)
|
||||
:fill "none"
|
||||
:id "base-background"}
|
||||
:hidden true
|
||||
:content []}
|
||||
|
||||
root-shape (create-svg-root id frame-id parent-id svg-data)
|
||||
root-id (:id root-shape)
|
||||
svg-data (-> svg-data
|
||||
(assoc :defs def-nodes)
|
||||
(assoc :content (into [background] (:content svg-data))))
|
||||
|
||||
;; Create the root shape
|
||||
root-attrs (-> (:attrs svg-data)
|
||||
(csvg/format-styles))
|
||||
root-shape (create-svg-root frame-id parent-id svg-data)
|
||||
root-id (:id root-shape)
|
||||
|
||||
[_ children]
|
||||
(reduce (partial create-svg-children objects selected frame-id root-id svg-data)
|
||||
[unames []]
|
||||
(d/enumerate (->> (:content svg-data)
|
||||
(mapv #(csvg/inherit-attributes root-attrs %)))))]
|
||||
;; Create the root shape
|
||||
root-attrs (-> (:attrs svg-data)
|
||||
(csvg/format-styles))
|
||||
|
||||
[root-shape children])))
|
||||
[_ children]
|
||||
(reduce (partial create-svg-children objects selected frame-id root-id svg-data)
|
||||
[unames []]
|
||||
(d/enumerate (->> (:content svg-data)
|
||||
(mapv #(csvg/inherit-attributes root-attrs %)))))]
|
||||
|
||||
[root-shape children]))
|
||||
|
||||
(defn create-raw-svg
|
||||
[name frame-id {:keys [x y width height offset-x offset-y]} {:keys [attrs] :as data}]
|
||||
@@ -159,13 +157,12 @@
|
||||
:svg-viewbox vbox})))
|
||||
|
||||
(defn create-svg-root
|
||||
[id frame-id parent-id {:keys [name x y width height offset-x offset-y attrs]}]
|
||||
[frame-id parent-id {:keys [name x y width height offset-x offset-y attrs]}]
|
||||
(let [props (-> (dissoc attrs :viewBox :view-box :xmlns)
|
||||
(d/without-keys csvg/inheritable-props)
|
||||
(csvg/attrs->props))]
|
||||
(cts/setup-shape
|
||||
{:id id
|
||||
:type :group
|
||||
{:type :group
|
||||
:name name
|
||||
:frame-id frame-id
|
||||
:parent-id parent-id
|
||||
|
||||
@@ -1,162 +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.test-helpers.components
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.test-helpers.files :as thf]
|
||||
[app.common.test-helpers.ids-map :as thi]
|
||||
[app.common.test-helpers.shapes :as ths]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.components-list :as ctkl]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape-tree :as ctst]))
|
||||
|
||||
(defn make-component
|
||||
[file label root-label & {:keys [] :as params}]
|
||||
(let [page (thf/current-page file)
|
||||
root (ths/get-shape file root-label)]
|
||||
|
||||
(dm/assert!
|
||||
"Need that root is already a frame"
|
||||
(cfh/frame-shape? root))
|
||||
|
||||
(let [[_new-root _new-shapes updated-shapes]
|
||||
(ctn/convert-shape-in-component root (:objects page) (:id file))
|
||||
|
||||
updated-root (first updated-shapes) ; Can't use new-root because it has a new id
|
||||
|
||||
[path name] (cfh/parse-path-name (:name updated-root))]
|
||||
(thi/set-id! label (:component-id updated-root))
|
||||
|
||||
(ctf/update-file-data
|
||||
file
|
||||
(fn [file-data]
|
||||
(as-> file-data $
|
||||
(reduce (fn [file-data shape]
|
||||
(ctpl/update-page file-data
|
||||
(:id page)
|
||||
#(update % :objects assoc (:id shape) shape)))
|
||||
$
|
||||
updated-shapes)
|
||||
(ctkl/add-component $ (assoc params
|
||||
:id (:component-id updated-root)
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id (:id updated-root)
|
||||
:main-instance-page (:id page)
|
||||
:shapes updated-shapes))))))))
|
||||
|
||||
(defn get-component
|
||||
[file label & {:keys [include-deleted?] :or {include-deleted? false}}]
|
||||
(ctkl/get-component (:data file) (thi/id label) include-deleted?))
|
||||
|
||||
(defn get-component-by-id
|
||||
[file id]
|
||||
(ctkl/get-component (:data file) id))
|
||||
|
||||
(defn- set-children-labels!
|
||||
[file shape-label children-labels]
|
||||
(doseq [[label id]
|
||||
(d/zip children-labels (cfh/get-children-ids (-> (thf/current-page file) :objects)
|
||||
(thi/id shape-label)))]
|
||||
(thi/set-id! label id)))
|
||||
|
||||
(defn instantiate-component
|
||||
[file component-label copy-root-label & {:keys [parent-label library children-labels] :as params}]
|
||||
(let [page (thf/current-page file)
|
||||
library (or library file)
|
||||
component (get-component library component-label)
|
||||
parent-id (when parent-label
|
||||
(thi/id parent-label))
|
||||
parent (when parent-id
|
||||
(ctst/get-shape page parent-id))
|
||||
frame-id (if (cfh/frame-shape? parent)
|
||||
(:id parent)
|
||||
(:frame-id parent))
|
||||
|
||||
[copy-root copy-shapes]
|
||||
(ctn/make-component-instance page
|
||||
component
|
||||
(:data library)
|
||||
(gpt/point 100 100)
|
||||
true
|
||||
{:force-id (thi/new-id! copy-root-label)
|
||||
:force-frame-id frame-id})
|
||||
|
||||
copy-root' (cond-> copy-root
|
||||
(some? parent)
|
||||
(assoc :parent-id parent-id)
|
||||
|
||||
(some? frame-id)
|
||||
(assoc :frame-id frame-id)
|
||||
|
||||
(and (some? parent) (ctn/in-any-component? (:objects page) parent))
|
||||
(dissoc :component-root))
|
||||
|
||||
file' (ctf/update-file-data
|
||||
file
|
||||
(fn [file-data]
|
||||
(as-> file-data $
|
||||
(ctpl/update-page $
|
||||
(:id page)
|
||||
#(ctst/add-shape (:id copy-root')
|
||||
copy-root'
|
||||
%
|
||||
frame-id
|
||||
parent-id
|
||||
nil
|
||||
true))
|
||||
(reduce (fn [file-data shape]
|
||||
(ctpl/update-page file-data
|
||||
(:id page)
|
||||
#(ctst/add-shape (:id shape)
|
||||
shape
|
||||
%
|
||||
(:frame-id shape)
|
||||
(:parent-id shape)
|
||||
nil
|
||||
true)))
|
||||
$
|
||||
(remove #(= (:id %) (:id copy-root')) copy-shapes)))))]
|
||||
|
||||
(when children-labels
|
||||
(set-children-labels! file' copy-root-label children-labels))
|
||||
|
||||
file'))
|
||||
|
||||
(defn component-swap
|
||||
[file shape-label new-component-label new-shape-label & {:keys [library children-labels] :as params}]
|
||||
(let [shape (ths/get-shape file shape-label)
|
||||
library (or library file)
|
||||
libraries {(:id library) library}
|
||||
page (thf/current-page file)
|
||||
objects (:objects page)
|
||||
id-new-component (-> (get-component library new-component-label)
|
||||
:id)
|
||||
|
||||
;; Store the properties that need to be maintained when the component is swapped
|
||||
keep-props-values (select-keys shape ctk/swap-keep-attrs)
|
||||
|
||||
[new_shape _ changes]
|
||||
(-> (pcb/empty-changes nil (:id page))
|
||||
(cll/generate-component-swap objects shape (:data file) page libraries id-new-component 0 nil keep-props-values))
|
||||
|
||||
file' (thf/apply-changes file changes)]
|
||||
|
||||
(thi/set-id! new-shape-label (:id new_shape))
|
||||
|
||||
(when children-labels
|
||||
(set-children-labels! file' new-shape-label children-labels))
|
||||
|
||||
file'))
|
||||
@@ -1,390 +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.test-helpers.compositions
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.logic.shapes :as cls]
|
||||
[app.common.test-helpers.components :as thc]
|
||||
[app.common.test-helpers.files :as thf]
|
||||
[app.common.test-helpers.shapes :as ths]
|
||||
[app.common.types.container :as ctn]))
|
||||
|
||||
;; ----- File building
|
||||
|
||||
(defn add-rect
|
||||
[file rect-label & {:keys [] :as params}]
|
||||
;; Generated shape tree:
|
||||
;; :rect-label [:type :rect :name Rect1]
|
||||
(ths/add-sample-shape file rect-label
|
||||
(merge {:type :rect
|
||||
:name "Rect1"}
|
||||
params)))
|
||||
|
||||
(defn add-frame
|
||||
[file frame-label & {:keys [] :as params}]
|
||||
;; Generated shape tree:
|
||||
;; :frame-label [:type :frame :name Frame1]
|
||||
(ths/add-sample-shape file frame-label
|
||||
(merge {:type :frame
|
||||
:name "Frame1"}
|
||||
params)))
|
||||
|
||||
(defn add-group
|
||||
[file group-label & {:keys [] :as params}]
|
||||
;; Generated shape tree:
|
||||
;; :group-label [:type :group :name Group1]
|
||||
(ths/add-sample-shape file group-label
|
||||
(merge {:type :group
|
||||
:name "Group1"}
|
||||
params)))
|
||||
|
||||
(defn add-frame-with-child
|
||||
[file frame-label child-label & {:keys [frame-params child-params]}]
|
||||
;; Generated shape tree:
|
||||
;; :frame-label [:name Frame1]
|
||||
;; :child-label [:name Rect1]
|
||||
(-> file
|
||||
(add-frame frame-label frame-params)
|
||||
(ths/add-sample-shape child-label
|
||||
(merge {:type :rect
|
||||
:name "Rect1"
|
||||
:parent-label frame-label}
|
||||
child-params))))
|
||||
|
||||
(defn add-minimal-component
|
||||
[file component-label root-label
|
||||
& {:keys [component-params root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
(-> file
|
||||
(add-frame root-label root-params)
|
||||
(thc/make-component component-label root-label component-params)))
|
||||
|
||||
(defn add-minimal-component-with-copy
|
||||
[file component-label main-root-label copy-root-label
|
||||
& {:keys [component-params main-root-params copy-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main-root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :copy-root-label [:name Frame1] #--> [Component :component-label] :main-root-label
|
||||
(-> file
|
||||
(add-minimal-component component-label
|
||||
main-root-label
|
||||
:component-params component-params
|
||||
:root-params main-root-params)
|
||||
(thc/instantiate-component component-label copy-root-label copy-root-params)))
|
||||
|
||||
(defn add-simple-component
|
||||
[file component-label root-label child-label
|
||||
& {:keys [component-params root-params child-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child-label [:name Rect1]
|
||||
(-> file
|
||||
(add-frame-with-child root-label child-label :frame-params root-params :child-params child-params)
|
||||
(thc/make-component component-label root-label component-params)))
|
||||
|
||||
(defn add-simple-component-with-copy
|
||||
[file component-label main-root-label main-child-label copy-root-label
|
||||
& {:keys [component-params main-root-params main-child-params copy-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main-root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :main-child-label [:name Rect1]
|
||||
;;
|
||||
;; :copy-root-label [:name Frame1] #--> [Component :component-label] :main-root-label
|
||||
;; <no-label> [:name Rect1] ---> :main-child-label
|
||||
(-> file
|
||||
(add-simple-component component-label
|
||||
main-root-label
|
||||
main-child-label
|
||||
:component-params component-params
|
||||
:root-params main-root-params
|
||||
:child-params main-child-params)
|
||||
(thc/instantiate-component component-label copy-root-label copy-root-params)))
|
||||
|
||||
(defn add-component-with-many-children
|
||||
[file component-label root-label child-labels
|
||||
& {:keys [component-params root-params child-params-list]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
(as-> file $
|
||||
(add-frame $ root-label root-params)
|
||||
(reduce (fn [file [index [label params]]]
|
||||
(ths/add-sample-shape file
|
||||
label
|
||||
(merge {:type :rect
|
||||
:name (str "Rect" (inc index))
|
||||
:parent-label root-label}
|
||||
params)))
|
||||
$
|
||||
(d/enumerate (d/zip-all child-labels child-params-list)))
|
||||
(thc/make-component $ component-label root-label component-params)))
|
||||
|
||||
(defn add-component-with-many-children-and-copy
|
||||
[file component-label main-root-label main-child-labels copy-root-label
|
||||
& {:keys [component-params main-root-params main-child-params-list copy-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
;;
|
||||
;; :copy-root-label [:name Frame1] #--> [Component :component-label] :root-label
|
||||
;; <no-label> [:name Rect1] ---> :child1-label
|
||||
;; <no-label> [:name Rect2] ---> :child2-label
|
||||
;; <no-label> [:name Rect3] ---> :child3-label
|
||||
(-> file
|
||||
(add-component-with-many-children component-label
|
||||
main-root-label
|
||||
main-child-labels
|
||||
:component-params component-params
|
||||
:root-params main-root-params
|
||||
:child-params-list main-child-params-list)
|
||||
(thc/instantiate-component component-label copy-root-label copy-root-params)))
|
||||
|
||||
(defn add-nested-component
|
||||
[file component1-label main1-root-label main1-child-label component2-label main2-root-label nested-head-label
|
||||
& {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main1-root-label} [:name Frame1] # [Component :component1-label]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;;
|
||||
;; {:main2-root-label} [:name Frame2] # [Component :component2-label]
|
||||
;; :nested-head-label [:name Frame1] @--> [Component :component1-label] :main1-root-label
|
||||
;; <no-label> [:name Rect1] ---> :main1-child-label
|
||||
(-> file
|
||||
(add-simple-component component1-label
|
||||
main1-root-label
|
||||
main1-child-label
|
||||
:component-params component1-params
|
||||
:root-params root1-params
|
||||
:child-params main1-child-params)
|
||||
(add-frame main2-root-label (merge {:name "Frame2"}
|
||||
main2-root-params))
|
||||
(thc/instantiate-component component1-label
|
||||
nested-head-label
|
||||
(assoc nested-head-params
|
||||
:parent-label main2-root-label))
|
||||
(thc/make-component component2-label
|
||||
main2-root-label
|
||||
component2-params)))
|
||||
|
||||
(defn add-nested-component-with-copy
|
||||
[file component1-label main1-root-label main1-child-label component2-label main2-root-label nested-head-label copy2-root-label
|
||||
& {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params copy2-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main1-root-label} [:name Frame1] # [Component :component1-label]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;;
|
||||
;; {:main2-root-label} [:name Frame2] # [Component :component2-label]
|
||||
;; :nested-head-label [:name Frame1] @--> [Component :component1-label] :main1-root-label
|
||||
;; <no-label> [:name Rect1] ---> :main1-child-label
|
||||
;;
|
||||
;; :copy2-label [:name Frame2] #--> [Component :component2-label] :main2-root-label
|
||||
;; <no-label> [:name Frame1] @--> [Component :component1-label] :nested-head-label
|
||||
;; <no-label> [:name Rect1] ---> <no-label>
|
||||
(-> file
|
||||
(add-nested-component component1-label
|
||||
main1-root-label
|
||||
main1-child-label
|
||||
component2-label
|
||||
main2-root-label
|
||||
nested-head-label
|
||||
:component1-params component1-params
|
||||
:root1-params root1-params
|
||||
:main1-child-params main1-child-params
|
||||
:component2-params component2-params
|
||||
:main2-root-params main2-root-params
|
||||
:nested-head-params nested-head-params)
|
||||
(thc/instantiate-component component2-label copy2-root-label copy2-root-params)))
|
||||
|
||||
;; ----- Getters
|
||||
|
||||
(defn bottom-shape-by-id
|
||||
"Get the deepest descendant of a shape by id"
|
||||
[file id & {:keys [page-label]}]
|
||||
(let [shape (ths/get-shape-by-id file id :page-label page-label)]
|
||||
(if (some? (:shapes shape))
|
||||
(let [child-id (-> (:shapes shape)
|
||||
first)]
|
||||
(bottom-shape-by-id file child-id :page-label page-label))
|
||||
shape)))
|
||||
|
||||
(defn bottom-shape
|
||||
"Get the deepest descendant of a shape by tag"
|
||||
[file tag & {:keys [page-label]}]
|
||||
(let [shape (ths/get-shape file tag :page-label page-label)]
|
||||
(bottom-shape-by-id file (:id shape) :page-label page-label)))
|
||||
|
||||
(defn bottom-fill-color
|
||||
"Get the first fill color of the deepest descendant of a shape by tag"
|
||||
[file tag & {:keys [page-label]}]
|
||||
(-> (bottom-shape file tag :page-label page-label)
|
||||
:fills
|
||||
first
|
||||
:fill-color))
|
||||
|
||||
;; ----- File modifiers
|
||||
|
||||
(defn propagate-component-changes
|
||||
"Propagates the component changes for component specified by component-tag"
|
||||
[file component-tag]
|
||||
(let [file-id (:id file)
|
||||
|
||||
changes (-> (pcb/empty-changes)
|
||||
(cll/generate-sync-file-changes
|
||||
nil
|
||||
:components
|
||||
file-id
|
||||
(:id (thc/get-component file component-tag))
|
||||
file-id
|
||||
{file-id file}
|
||||
file-id))]
|
||||
(thf/apply-changes file changes)))
|
||||
|
||||
(defn swap-component
|
||||
"Swap the specified shape by the component specified by component-tag"
|
||||
[file shape component-tag & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
|
||||
[_ _all-parents changes]
|
||||
(cll/generate-component-swap (pcb/empty-changes)
|
||||
(:objects page)
|
||||
shape
|
||||
(:data file)
|
||||
page
|
||||
{(:id file) file}
|
||||
(-> (thc/get-component file component-tag)
|
||||
:id)
|
||||
0
|
||||
nil
|
||||
{})
|
||||
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
(defn swap-component-in-shape [file shape-tag component-tag & {:keys [page-label propagate-fn]}]
|
||||
(swap-component file (ths/get-shape file shape-tag :page-label page-label) component-tag :page-label page-label :propagate-fn propagate-fn))
|
||||
|
||||
(defn swap-component-in-first-child [file shape-tag component-tag & {:keys [page-label propagate-fn]}]
|
||||
(let [first-child-id (->> (ths/get-shape file shape-tag :page-label page-label)
|
||||
:shapes
|
||||
first)]
|
||||
(swap-component file
|
||||
(ths/get-shape-by-id file first-child-id :page-label page-label)
|
||||
component-tag
|
||||
:page-label page-label
|
||||
:propagate-fn propagate-fn)))
|
||||
|
||||
(defn update-color
|
||||
"Update the first fill color for the shape identified by shape-tag"
|
||||
[file shape-tag color & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
changes
|
||||
(cls/generate-update-shapes (pcb/empty-changes nil (:id page))
|
||||
#{(:id (ths/get-shape file shape-tag :page-label page-label))}
|
||||
(fn [shape]
|
||||
(assoc shape :fills (ths/sample-fills-color :fill-color color)))
|
||||
(:objects page)
|
||||
{})
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
(defn update-bottom-color
|
||||
"Update the first fill color of the deepest descendant for the shape identified by shape-tag"
|
||||
[file shape-tag color & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
changes
|
||||
(cls/generate-update-shapes (pcb/empty-changes nil (:id page))
|
||||
#{(:id (bottom-shape file shape-tag :page-label page-label))}
|
||||
(fn [shape]
|
||||
(assoc shape :fills (ths/sample-fills-color :fill-color color)))
|
||||
(:objects page)
|
||||
{})
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
(defn reset-overrides [file shape & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
container (ctn/make-container page :page)
|
||||
file-id (:id file)
|
||||
changes (-> (pcb/empty-changes)
|
||||
(cll/generate-reset-component
|
||||
file
|
||||
{file-id file}
|
||||
(ctn/make-container container :page)
|
||||
(:id shape)
|
||||
true))
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
(defn reset-overrides-in-first-child [file shape-tag & {:keys [page-label propagate-fn]}]
|
||||
(let [first-child-id (->>
|
||||
(ths/get-shape file shape-tag :page-label page-label)
|
||||
:shapes
|
||||
first)
|
||||
shape (ths/get-shape-by-id file first-child-id :page-label page-label)]
|
||||
(reset-overrides file shape :page-label page-label :propagate-fn propagate-fn)))
|
||||
|
||||
(defn delete-shape [file shape-tag & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
[_ changes] (cls/generate-delete-shapes (pcb/empty-changes nil (:id page))
|
||||
file
|
||||
page
|
||||
(:objects page)
|
||||
#{(-> (ths/get-shape file shape-tag :page-label page-label)
|
||||
:id)}
|
||||
{:components-v2 true})
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
(defn duplicate-shape [file shape-tag & {:keys [page-label propagate-fn]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))
|
||||
shape (ths/get-shape file shape-tag :page-label page-label)
|
||||
changes
|
||||
(-> (pcb/empty-changes nil)
|
||||
(cll/generate-duplicate-changes (:objects page) ;; objects
|
||||
page ;; page
|
||||
#{(:id shape)} ;; ids
|
||||
(gpt/point 0 0) ;; delta
|
||||
{(:id file) file} ;; libraries
|
||||
(:data file) ;; library-data
|
||||
(:id file)) ;; file-id
|
||||
(cll/generate-duplicate-changes-update-indices (:objects page) ;; objects
|
||||
#{(:id shape)}))
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
file')))
|
||||
|
||||
@@ -1,189 +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.test-helpers.files
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.features :as ffeat]
|
||||
[app.common.files.changes :as cfc]
|
||||
[app.common.files.validate :as cfv]
|
||||
[app.common.pprint :refer [pprint]]
|
||||
[app.common.test-helpers.ids-map :as thi]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
;; ----- Files
|
||||
|
||||
(defn sample-file
|
||||
[label & {:keys [page-label name] :as params}]
|
||||
(binding [ffeat/*current* #{"components/v2"}]
|
||||
(let [params (cond-> params
|
||||
label
|
||||
(assoc :id (thi/new-id! label))
|
||||
|
||||
page-label
|
||||
(assoc :page-id (thi/new-id! page-label))
|
||||
|
||||
(nil? name)
|
||||
(assoc :name "Test file"))
|
||||
|
||||
file (-> (ctf/make-file (dissoc params :page-label))
|
||||
(assoc :features #{"components/v2"}))
|
||||
|
||||
page (-> file
|
||||
:data
|
||||
(ctpl/pages-seq)
|
||||
(first))]
|
||||
|
||||
(with-meta file
|
||||
{:current-page-id (:id page)}))))
|
||||
|
||||
(defn validate-file!
|
||||
([file] (validate-file! file {}))
|
||||
([file libraries]
|
||||
(cfv/validate-file-schema! file)
|
||||
(cfv/validate-file! file libraries)))
|
||||
|
||||
(defn apply-changes
|
||||
[file changes]
|
||||
(let [file' (ctf/update-file-data file #(cfc/process-changes % (:redo-changes changes) true))]
|
||||
(validate-file! file')
|
||||
file'))
|
||||
|
||||
;; ----- Pages
|
||||
|
||||
(defn sample-page
|
||||
[label & {:keys [] :as params}]
|
||||
(ctp/make-empty-page (assoc params :id (thi/new-id! label))))
|
||||
|
||||
(defn add-sample-page
|
||||
[file label & {:keys [] :as params}]
|
||||
(let [page (sample-page label params)]
|
||||
(-> file
|
||||
(ctf/update-file-data #(ctpl/add-page % page))
|
||||
(vary-meta assoc :current-page-id (:id page)))))
|
||||
|
||||
(defn get-page
|
||||
[file label]
|
||||
(ctpl/get-page (:data file) (thi/id label)))
|
||||
|
||||
(defn current-page-id
|
||||
[file]
|
||||
(:current-page-id (meta file)))
|
||||
|
||||
(defn current-page
|
||||
[file]
|
||||
(ctpl/get-page (:data file) (current-page-id file)))
|
||||
|
||||
(defn switch-to-page
|
||||
[file label]
|
||||
(vary-meta file assoc :current-page-id (thi/id label)))
|
||||
|
||||
;; ----- Debug
|
||||
|
||||
(defn dump-tree
|
||||
"Dump a file using dump-tree function in common.types.file."
|
||||
[file & {:keys [page-label libraries] :as params}]
|
||||
(let [params (-> params
|
||||
(or {:show-ids true :show-touched true})
|
||||
(dissoc page-label libraries))
|
||||
page (if (some? page-label)
|
||||
(:id (get-page file page-label))
|
||||
(current-page-id file))
|
||||
libraries (or libraries {})]
|
||||
|
||||
(ctf/dump-tree file page libraries params)))
|
||||
|
||||
(defn pprint-file
|
||||
"Pretry print a file trying to limit the quantity of info shown."
|
||||
[file & {:keys [level length] :or {level 10 length 1000}}]
|
||||
(pprint file {:level level :length length}))
|
||||
|
||||
(defn dump-shape
|
||||
"Dump a shape, with each attribute in a line."
|
||||
[shape]
|
||||
(println "{")
|
||||
(doseq [[k v] (sort shape)]
|
||||
(when (some? v)
|
||||
(println (str " " k " : " v))))
|
||||
(println "}"))
|
||||
|
||||
(defn- stringify-keys [m keys]
|
||||
(let [kv (-> (select-keys m keys)
|
||||
(assoc :swap-slot (when ((set keys) :swap-slot)
|
||||
(ctk/get-swap-slot m)))
|
||||
(assoc :swap-slot-label (when ((set keys) :swap-slot-label)
|
||||
(when-let [slot (ctk/get-swap-slot m)]
|
||||
(thi/label slot))))
|
||||
(d/without-nils))
|
||||
|
||||
pretty-uuid (fn [id]
|
||||
(let [id (str id)]
|
||||
(str "#" (subs id (- (count id) 6)))))
|
||||
|
||||
format-kv (fn [[k v]]
|
||||
(cond
|
||||
(uuid? v)
|
||||
(str k " " (pretty-uuid v))
|
||||
|
||||
:else
|
||||
(str k " " v)))]
|
||||
|
||||
(when (seq kv)
|
||||
(str " [" (apply str (interpose ", " (map format-kv kv))) "]"))))
|
||||
|
||||
(defn- dump-page-shape
|
||||
[shape keys padding show-refs?]
|
||||
(println (str/pad (str padding
|
||||
(when (and (:main-instance shape) show-refs?) "{")
|
||||
(thi/label (:id shape))
|
||||
(when (and (:main-instance shape) show-refs?) "}")
|
||||
(when (seq keys)
|
||||
(stringify-keys shape keys)))
|
||||
{:length 50 :type :right})
|
||||
(if (nil? (:shape-ref shape))
|
||||
(if (and (:component-root shape) show-refs?)
|
||||
(str "# [Component " (thi/label (:component-id shape)) "]")
|
||||
"")
|
||||
(if show-refs?
|
||||
(str/format "%s--> %s%s"
|
||||
(cond (:component-root shape) "#"
|
||||
(:component-id shape) "@"
|
||||
:else "-")
|
||||
(if (:component-root shape)
|
||||
(str "[Component " (thi/label (:component-id shape)) "] ")
|
||||
"")
|
||||
(thi/label (:shape-ref shape)))
|
||||
""))))
|
||||
|
||||
(defn dump-page
|
||||
"Dump the layer tree of the page, showing labels of the shapes.
|
||||
- keys: a list of attributes of the shapes you want to show. In addition, you
|
||||
can add :swap-slot to show the slot id (if any) or :swap-slot-label
|
||||
to show the corresponding label.
|
||||
- show-refs?: if true, the component references will be shown."
|
||||
[page & {:keys [keys root-id padding show-refs?]
|
||||
:or {keys [:name :swap-slot-label] root-id uuid/zero padding "" show-refs? true}}]
|
||||
(let [lookupf (d/getf (:objects page))
|
||||
root-shape (lookupf root-id)
|
||||
shapes (map lookupf (:shapes root-shape))]
|
||||
(doseq [shape shapes]
|
||||
(dump-page-shape shape keys padding show-refs?)
|
||||
(dump-page page
|
||||
:keys keys
|
||||
:root-id (:id shape)
|
||||
:padding (str padding " ")
|
||||
:show-refs? show-refs?))))
|
||||
|
||||
(defn dump-file
|
||||
"Dump the current page of the file, using dump-page above.
|
||||
Example: (thf/dump-file file :keys [:name :swap-slot-label] :show-refs? false)"
|
||||
[file & {:keys [] :as params}]
|
||||
(dump-page (current-page file) params))
|
||||
@@ -1,50 +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.test-helpers.ids-map
|
||||
(:require
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
;; ---- Helpers to manage ids as known identifiers
|
||||
|
||||
(def ^:private idmap (atom {}))
|
||||
(def ^:private next-uuid-val (atom 1))
|
||||
|
||||
(defn reset-idmap! []
|
||||
(reset! idmap {})
|
||||
(reset! next-uuid-val 1))
|
||||
|
||||
(defn set-id!
|
||||
[label id]
|
||||
(swap! idmap assoc label id))
|
||||
|
||||
(defn new-id!
|
||||
[label]
|
||||
(let [id (uuid/next)]
|
||||
(set-id! label id)
|
||||
id))
|
||||
|
||||
(defn id
|
||||
[label]
|
||||
(get @idmap label))
|
||||
|
||||
(defn test-fixture
|
||||
;; Ensure that each test starts with a clean ids map
|
||||
[f]
|
||||
(reset-idmap!)
|
||||
(f))
|
||||
|
||||
(defn label [id]
|
||||
(or (->> @idmap
|
||||
(filter #(= id (val %)))
|
||||
(map key)
|
||||
(first))
|
||||
(str "<no-label #" (subs (str id) (- (count (str id)) 6)) ">")))
|
||||
|
||||
(defn next-uuid []
|
||||
(let [current (uuid/custom @next-uuid-val)]
|
||||
(swap! next-uuid-val inc)
|
||||
current))
|
||||
@@ -1,118 +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.test-helpers.shapes
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.test-helpers.files :as thf]
|
||||
[app.common.test-helpers.ids-map :as thi]
|
||||
[app.common.types.color :as ctc]
|
||||
[app.common.types.colors-list :as ctcl]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.typographies-list :as cttl]
|
||||
[app.common.types.typography :as ctt]))
|
||||
|
||||
(defn sample-shape
|
||||
[label & {:keys [type] :as params}]
|
||||
(let [params (cond-> params
|
||||
label
|
||||
(assoc :id (thi/new-id! label))
|
||||
|
||||
(nil? type)
|
||||
(assoc :type :rect))]
|
||||
|
||||
(cts/setup-shape params)))
|
||||
|
||||
(defn add-sample-shape
|
||||
[file label & {:keys [parent-label] :as params}]
|
||||
(let [page (thf/current-page file)
|
||||
shape (sample-shape label (dissoc params :parent-label))
|
||||
parent-id (when parent-label
|
||||
(thi/id parent-label))
|
||||
parent (when parent-id
|
||||
(ctst/get-shape page parent-id))
|
||||
frame-id (if (cfh/frame-shape? parent)
|
||||
(:id parent)
|
||||
(:frame-id parent))]
|
||||
(ctf/update-file-data
|
||||
file
|
||||
(fn [file-data]
|
||||
(ctpl/update-page file-data
|
||||
(:id page)
|
||||
#(ctst/add-shape (:id shape)
|
||||
shape
|
||||
%
|
||||
frame-id
|
||||
parent-id
|
||||
nil
|
||||
true))))))
|
||||
|
||||
(defn get-shape
|
||||
[file label & {:keys [page-label]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))]
|
||||
(ctst/get-shape page (thi/id label))))
|
||||
|
||||
(defn get-shape-by-id
|
||||
[file id & {:keys [page-label]}]
|
||||
(let [page (if page-label
|
||||
(thf/get-page file page-label)
|
||||
(thf/current-page file))]
|
||||
(ctst/get-shape page id)))
|
||||
|
||||
(defn sample-color
|
||||
[label & {:keys [] :as params}]
|
||||
(ctc/make-color (assoc params :id (thi/new-id! label))))
|
||||
|
||||
(defn sample-fill-color
|
||||
[& {:keys [fill-color fill-opacity] :as params}]
|
||||
(let [params (cond-> params
|
||||
(nil? fill-color)
|
||||
(assoc :fill-color clr/black)
|
||||
|
||||
(nil? fill-opacity)
|
||||
(assoc :fill-opacity 1))]
|
||||
params))
|
||||
|
||||
(defn sample-fills-color
|
||||
[& {:keys [] :as params}]
|
||||
[(sample-fill-color params)])
|
||||
|
||||
(defn add-sample-library-color
|
||||
[file label & {:keys [] :as params}]
|
||||
(let [color (sample-color label params)]
|
||||
(ctf/update-file-data file #(ctcl/add-color % color))))
|
||||
|
||||
(defn sample-typography
|
||||
[label & {:keys [] :as params}]
|
||||
(ctt/make-typography (assoc params :id (thi/new-id! label))))
|
||||
|
||||
(defn add-sample-typography
|
||||
[file label & {:keys [] :as params}]
|
||||
(let [typography (sample-typography label params)]
|
||||
(ctf/update-file-data file #(cttl/add-typography % typography))))
|
||||
|
||||
(defn add-interaction
|
||||
[file origin-label dest-label]
|
||||
(let [page (thf/current-page file)
|
||||
origin (get-shape file origin-label)
|
||||
dest (get-shape file dest-label)
|
||||
interaction (-> ctsi/default-interaction
|
||||
(ctsi/set-destination (:id dest))
|
||||
(assoc :position-relative-to (:id origin)))
|
||||
interactions (ctsi/add-interaction (:interactions origin) interaction)]
|
||||
(ctf/update-file-data
|
||||
file
|
||||
(fn [file-data]
|
||||
(ctpl/update-page file-data
|
||||
(:id page)
|
||||
#(ctst/set-shape % (assoc origin :interactions interactions)))))))
|
||||
@@ -381,57 +381,6 @@
|
||||
(-> (rec-style-text-map [] node {})
|
||||
reverse)))
|
||||
|
||||
(defn content->text
|
||||
"Given a root node of a text content extracts the texts with its associated styles"
|
||||
[content]
|
||||
(letfn [(add-node [acc node]
|
||||
(cond
|
||||
(is-paragraph-node? node)
|
||||
(conj acc [])
|
||||
|
||||
(is-text-node? node)
|
||||
(let [i (dec (count acc))]
|
||||
(update acc i conj (:text node)))
|
||||
|
||||
:else
|
||||
acc))]
|
||||
(->> (node-seq content)
|
||||
(reduce add-node [])
|
||||
(map #(str/join "" %))
|
||||
(str/join "\n"))))
|
||||
|
||||
(defn change-text
|
||||
"Changes the content of the text shape to use the text as argument. Will use the styles of the
|
||||
first paragraph and text that is present in the shape (and override the rest)"
|
||||
[shape text]
|
||||
(let [content (:content shape)
|
||||
|
||||
paragraph-style (merge
|
||||
default-text-attrs
|
||||
(select-keys (->> content (node-seq is-paragraph-node?) first) text-all-attrs))
|
||||
text-style (merge
|
||||
default-text-attrs
|
||||
(select-keys (->> content (node-seq is-text-node?) first) text-all-attrs))
|
||||
|
||||
paragraph-texts (str/split text "\n")
|
||||
|
||||
paragraphs
|
||||
(->> paragraph-texts
|
||||
(mapv
|
||||
(fn [pt]
|
||||
(merge
|
||||
paragraph-style
|
||||
{:type "paragraph"
|
||||
:children [(merge {:text pt} text-style)]}))))
|
||||
|
||||
new-content
|
||||
{:type "root"
|
||||
:children
|
||||
[{:type "paragraph-set"
|
||||
:children paragraphs}]}]
|
||||
|
||||
(assoc shape :content new-content)))
|
||||
|
||||
(defn index-content
|
||||
"Adds a property `$id` that identifies the current node inside"
|
||||
([content]
|
||||
|
||||
@@ -13,7 +13,6 @@
|
||||
[app.common.types.color.generic :as-alias color-generic]
|
||||
[app.common.types.color.gradient :as-alias color-gradient]
|
||||
[app.common.types.color.gradient.stop :as-alias color-gradient-stop]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.test.check.generators :as tgen]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -106,22 +105,6 @@
|
||||
;; HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- factory
|
||||
|
||||
(defn make-color
|
||||
[{:keys [id name path value color opacity ref-id ref-file gradient image]}]
|
||||
(-> {:id (or id (uuid/next))
|
||||
:name (or name color "Black")
|
||||
:path path
|
||||
:value value
|
||||
:color (or color "#000000")
|
||||
:opacity (or opacity 1)
|
||||
:ref-id ref-id
|
||||
:ref-file ref-file
|
||||
:gradient gradient
|
||||
:image image}
|
||||
(d/without-nils)))
|
||||
|
||||
;; --- fill
|
||||
|
||||
(defn fill->shape-color
|
||||
|
||||
@@ -130,15 +130,6 @@
|
||||
(and (some? (:component-id shape))
|
||||
(nil? (:component-root shape))))
|
||||
|
||||
(defn subcopy-head?
|
||||
"Check if this shape is the head of a subinstance that is a copy."
|
||||
[shape]
|
||||
;; This is redundant with the previous one, but may give more security
|
||||
;; in case of bugs.
|
||||
(and (some? (:component-id shape))
|
||||
(nil? (:component-root shape))
|
||||
(some? (:shape-ref shape))))
|
||||
|
||||
(defn instance-of?
|
||||
[shape file-id component-id]
|
||||
(and (some? (:component-id shape))
|
||||
@@ -183,42 +174,20 @@
|
||||
(and (= shape-id (:main-instance-id component))
|
||||
(= page-id (:main-instance-page component))))
|
||||
|
||||
(defn set-touched-group
|
||||
[touched group]
|
||||
(when group
|
||||
(conj (or touched #{}) group)))
|
||||
|
||||
(defn touched-group?
|
||||
[shape group]
|
||||
((or (:touched shape) #{}) group))
|
||||
|
||||
(defn build-swap-slot-group
|
||||
"Convert a swap-slot into a :touched group"
|
||||
[swap-slot]
|
||||
(when swap-slot
|
||||
(keyword (str "swap-slot-" swap-slot))))
|
||||
|
||||
(defn swap-slot?
|
||||
[group]
|
||||
(str/starts-with? (name group) "swap-slot-"))
|
||||
|
||||
(defn group->swap-slot
|
||||
[group]
|
||||
(uuid/uuid (subs (name group) 10)))
|
||||
|
||||
(defn get-swap-slot
|
||||
"If the shape has a :touched group in the form :swap-slot-<uuid>, get the id."
|
||||
[shape]
|
||||
(let [group (d/seek swap-slot? (:touched shape))]
|
||||
(let [group (->> (:touched shape)
|
||||
(map name)
|
||||
(d/seek #(str/starts-with? % "swap-slot-")))]
|
||||
(when group
|
||||
(group->swap-slot group))))
|
||||
|
||||
(defn set-swap-slot
|
||||
"Add a touched group with a form :swap-slot-<uuid>."
|
||||
[shape swap-slot]
|
||||
(cond-> shape
|
||||
(some? swap-slot)
|
||||
(update :touched set-touched-group (build-swap-slot-group swap-slot))))
|
||||
(uuid/uuid (subs group 10)))))
|
||||
|
||||
(defn match-swap-slot?
|
||||
[shape-main shape-inst]
|
||||
@@ -258,6 +227,7 @@
|
||||
:shape-ref
|
||||
:touched))
|
||||
|
||||
|
||||
(defn- extract-ids [shape]
|
||||
(if (map? shape)
|
||||
(let [current-id (:id shape)
|
||||
@@ -286,16 +256,3 @@
|
||||
;; Non instance, non copy. We allow
|
||||
(or (not (instance-head? shape))
|
||||
(not (in-component-copy? parent))))))
|
||||
|
||||
(defn all-touched-groups
|
||||
[]
|
||||
(into #{} (vals sync-attrs)))
|
||||
|
||||
(defn valid-touched-group?
|
||||
[group]
|
||||
(try
|
||||
(or ((all-touched-groups) group)
|
||||
(and (swap-slot? group)
|
||||
(some? (group->swap-slot group))))
|
||||
(catch #?(:clj Throwable :cljs :default) _
|
||||
false)))
|
||||
@@ -375,11 +375,8 @@
|
||||
{:skip-components? true
|
||||
:bottom-frames? true
|
||||
;; We must avoid that destiny frame is inside the component frame
|
||||
:validator #(and
|
||||
;; We must avoid that destiny frame is inside the component frame
|
||||
(nil? (get component-children (:id %)))
|
||||
;; We must avoid that destiny frame is inside a copy
|
||||
(not (ctk/in-component-copy? %)))}))
|
||||
:validator #(nil? (get component-children (:id %)))}))
|
||||
|
||||
frame (get-shape container frame-id)
|
||||
component-frame (get-component-shape objects frame {:allow-main? true})
|
||||
|
||||
|
||||
@@ -9,7 +9,6 @@
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.defaults :refer [version]]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
@@ -79,7 +78,7 @@
|
||||
|
||||
([file-id page-id]
|
||||
(let [page (when (some? page-id)
|
||||
(ctp/make-empty-page {:id page-id :name "Page 1"}))]
|
||||
(ctp/make-empty-page page-id "Page 1"))]
|
||||
|
||||
(cond-> (assoc empty-file-data :id file-id)
|
||||
(some? page-id)
|
||||
@@ -88,34 +87,6 @@
|
||||
(contains? cfeat/*current* "components/v2")
|
||||
(assoc-in [:options :components-v2] true)))))
|
||||
|
||||
(defn make-file
|
||||
[{:keys [id project-id name revn is-shared features
|
||||
ignore-sync-until modified-at deleted-at
|
||||
create-page page-id]
|
||||
:or {is-shared false revn 0 create-page true}}]
|
||||
|
||||
(let [id (or id (uuid/next))
|
||||
|
||||
data (if create-page
|
||||
(if page-id
|
||||
(make-file-data id page-id)
|
||||
(make-file-data id))
|
||||
(make-file-data id nil))
|
||||
|
||||
file {:id id
|
||||
:project-id project-id
|
||||
:name name
|
||||
:revn revn
|
||||
:is-shared is-shared
|
||||
:version version
|
||||
:data data
|
||||
:features features
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at}]
|
||||
|
||||
(d/without-nils file)))
|
||||
|
||||
;; Helpers
|
||||
|
||||
(defn file-data
|
||||
@@ -486,7 +457,7 @@
|
||||
(gpt/point 0 0)
|
||||
(ctn/shapes-seq library-page))]
|
||||
[file-data (:id library-page) position])
|
||||
(let [library-page (ctp/make-empty-page {:id (uuid/next) :name "Main components"})]
|
||||
(let [library-page (ctp/make-empty-page (uuid/next) "Main components")]
|
||||
[(ctpl/add-page file-data library-page) (:id library-page) (gpt/point 0 0)]))))
|
||||
|
||||
(defn- absorb-components
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user