github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-05-14 20:43:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'staging'

Browse Source
This commit is contained in:
Andrey Antukh 2022-02-02 14:29:30 +01:00
commit 743c2c3385
451 changed files with 18540 additions and 7265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
.circleci/config.yml
View File

@ -47,6 +47,13 @@ jobs:
clj-kondo --version
clj-kondo --parallel --lint src/
- run:
name: frontend styles prettier
working_directory: "./frontend"
command: |
yarn install
yarn run lint-scss
- run:
name: backend lint
working_directory: "./backend"
@ -74,21 +81,27 @@ jobs:
node target/tests.js
environment:
JAVA_HOME: /usr/lib/jvm/openjdk16
PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
# - run:
# working_directory: "./common"
# name: common tests (cljs)
# command: |
# yarn install
# yarn run compile-test
# node target/test.js
#
# environment:
# PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
- run:
working_directory: "./common"
name: common tests
name: common tests (clj)
command: |
yarn install
clojure -M:dev:shadow-cljs compile test
node target/tests.js
clojure -X:dev:test
environment:
JAVA_HOME: /usr/lib/jvm/openjdk16
PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
- save_cache:
paths:

1
.clj-kondo/config.edn
View File

@ -10,7 +10,6 @@
{:analyze-call
{app.common.data/export hooks.export/export
potok.core/reify hooks.export/potok-reify
cljs.core/specify! hooks.export/clojure-specify
app.util.services/defmethod hooks.export/service-defmethod
}}

73
.gitignore vendored
View File

@ -1,47 +1,50 @@
figwheel_server.log
*.penpot
*.jar
*-init.clj
*.jar
*.penpot
.calva
.clj-kondo
.cpcache
.lein-deps-sum
.lein-failures
.lein-repl-history
.lein-plugins/
.repl
.lein-repl-history
.lsp
.nrepl-port
.cpcache
.nyc_output
.rebel_readline_history
node_modules
/clj-profiler/
/vendor/**/target
/cd.md
/backend/target/
/backend/resources/public/media
/backend/resources/public/assets
.repl
/.clj-kondo/.cache
/_dump
/backend/-
/backend/assets/
/backend/dist/
/backend/logs/
/backend/-
/telemetry/
/frontend/npm-debug.log
/frontend/target/
/frontend/dist/
/frontend/out/
/frontend/.shadow-cljs
/frontend/resources/public/*
/frontend/resources/fonts/experiments
/exporter/target
/exporter/.shadow-cljs
/docker/images/bundle*
/common/.shadow-cljs
/common/target
/.clj-kondo/.cache
/backend/resources/public/assets
/backend/resources/public/media
/backend/target/
/bundle*
/media
/cd.md
/clj-profiler/
/common/.shadow-cljs
/common/coverage
/common/target
/deploy
/web
/_dump
/docker/images/bundle*
/exporter/.shadow-cljs
/exporter/target
/frontend/.shadow-cljs
/frontend/cypress/videos/*/
/frontend/dist/
/frontend/npm-debug.log
/frontend/out/
/frontend/resources/fonts/experiments
/frontend/resources/public/*
/frontend/target/
/media
/telemetry/
/vendor/**/target
/vendor/svgclean/bundle*.js
.calva
.clj-kondo
.lsp
/web
clj-profiler/
figwheel_server.log
node_modules

322
CHANGES.md
View File

@ -1,15 +1,95 @@
# CHANGELOG
## :rocket: Next
## 1.11.0-beta
### :boom: Breaking changes
### :sparkles: New features
- Add an option to hide artboards names on the viewport [Taiga #2034](https://tree.taiga.io/project/penpot/issue/2034)
- Limit pasted object position to container boundaries [Taiga #2449](https://tree.taiga.io/project/penpot/us/2449)
- Add new options for zoom widget in workspace and viewer mode [Taiga #896](https://tree.taiga.io/project/penpot/us/896)
- Allow decimals on stroke width and positions [Taiga #2035](https://tree.taiga.io/project/penpot/issue/2035)
- Ability to ignore background when exporting an artboard [Taiga #1395](https://tree.taiga.io/project/penpot/us/1395)
- Show color hex or name on hover [Taiga #2413](https://tree.taiga.io/project/penpot/us/2413)
- Add shortcut to create artboard from selected objects [Taiga #2412](https://tree.taiga.io/project/penpot/us/2412)
- Add shortcut for opacity [Taiga #2442](https://tree.taiga.io/project/penpot/us/2442)
- Setting fill automatically for new texts [Taiga #2441](https://tree.taiga.io/project/penpot/us/2441)
- Add shortcut to move action [Github #1213](https://github.com/penpot/penpot/issues/1213)
- Add alt as mod key to add stroke color from library menu [Taiga #2207](https://tree.taiga.io/project/penpot/us/2207)
- Add detach in bulk option to context menu [Taiga #2210](https://tree.taiga.io/project/penpot/us/2210)
- Add penpot look and feel to multiuser cursors [Taiga #1387](https://tree.taiga.io/project/penpot/us/1387)
- Add actions to go to main component context menu option [Taiga #2053](https://tree.taiga.io/project/penpot/us/2053)
- Add contrast between component select color and shape select color [Taiga #2121](https://tree.taiga.io/project/penpot/issue/2121)
- Add animations in interactions [Taiga #2244](https://tree.taiga.io/project/penpot/us/2244)
- Add performance improvements on .penpot file import process [Taiga #2497](https://tree.taiga.io/project/penpot/us/2497)
- On team settings set color of members count to black [Taiga #2607](https://tree.taiga.io/project/penpot/us/2607)
### :bug: Bugs fixed
- Fix remove gradient if any when applying color from library [Taiga #2299](https://tree.taiga.io/project/penpot/issue/2299)
- Fix Enter as key action to exit edit path [Taiga #2444](https://tree.taiga.io/project/penpot/issue/2444)
- Fix add fill color from palette to groups and components [Taiga #2313](https://tree.taiga.io/project/penpot/issue/2313)
- Fix default project name in all languages [Taiga #2280](https://tree.taiga.io/project/penpot/issue/2280)
- Fix line-height and letter-spacing inputs to allow negative values [Taiga #2381](https://tree.taiga.io/project/penpot/issue/2381)
- Fix typo in Handoff tooltip [Taiga #2428](https://tree.taiga.io/project/penpot/issue/2428)
- Fix crash when pressing Shift+1 on empty file [#1435](https://github.com/penpot/penpot/issues/1435)
- Fix masked group resize strange behavior [Taiga #2317](https://tree.taiga.io/project/penpot/issue/2317)
- Fix problems when exporting all artboards [Taiga #2234](https://tree.taiga.io/project/penpot/issue/2234)
- Fix problems with team management [#1353](https://github.com/penpot/penpot/issues/1353)
- Fix problem when importing in shared libraries [#1362](https://github.com/penpot/penpot/issues/1362)
- Fix problem with join nodes [#1422](https://github.com/penpot/penpot/issues/1422)
- After team onboarding importing a file will import into the team drafts [Taiga #2408](https://tree.taiga.io/project/penpot/issue/2408)
- Fix problem exporting shapes from handoff mode [Taiga #2386](https://tree.taiga.io/project/penpot/issue/2386)
- Fix lock/hide elements in context menu when multiples shapes selected [Taiga #2340](https://tree.taiga.io/project/penpot/issue/2340)
- Fix problem with booleans [Taiga #2356](https://tree.taiga.io/project/penpot/issue/2356)
- Fix line-height/letter-spacing inputs behaviour [Taiga #2331](https://tree.taiga.io/project/penpot/issue/2331)
- Fix dotted style in strokes [Taiga #2312](https://tree.taiga.io/project/penpot/issue/2312)
- Fix problem when resizing texts inside groups [Taiga #2310](https://tree.taiga.io/project/penpot/issue/2310)
- Fix problem with multiple exports [Taiga #2468](https://tree.taiga.io/project/penpot/issue/2468)
- Allow import to continue from recoverable failures [#1412](https://github.com/penpot/penpot/issues/1412)
- Improved behaviour on text options when not text is selected [Taiga #2390](https://tree.taiga.io/project/penpot/issue/2390)
- Fix decimal numbers in export viewbox [Taiga #2290](https://tree.taiga.io/project/penpot/issue/2290)
- Right click over artboard name to open its menu [Taiga #1679](https://tree.taiga.io/project/penpot/issue/1679)
- Make the default session cookue use SameSite=Lax instead of Strict (causes some issues in latest versions of Chrome)
- Fix "open in new tab" on dashboard [Taiga #2235](https://tree.taiga.io/project/penpot/issue/2355)
- Changing pages while comments activated will not close the panel [#1350](https://github.com/penpot/penpot/issues/1350)
- Fix navigate comments in right sidebar [Taiga #2163](https://tree.taiga.io/project/penpot/issue/2163)
- Fix keep name of component equal to the shape name [Taiga #2341](https://tree.taiga.io/project/penpot/issue/2341)
- Fix lossing changes when changing selection and an input was already changed [Taiga #2329](https://tree.taiga.io/project/penpot/issue/2329), [Taiga #2330](https://tree.taiga.io/project/penpot/issue/2330)
- Fix blur input field when click on viewport [Taiga #2164](https://tree.taiga.io/project/penpot/issue/2164)
- Fix default page id in workspace [Taiga #2205](https://tree.taiga.io/project/penpot/issue/2205)
- Fix problem when importing a file with grids [Taiga #2314](https://tree.taiga.io/project/penpot/issue/2314)
- Fix problem with imported svgs with filters [Taiga #2478](https://tree.taiga.io/project/penpot/issue/2478)
- Fix issues when updating selrect in paths [Taiga #2366](https://tree.taiga.io/project/penpot/issue/2366)
- Fix scroll jumps in handoff mode [Taiga #2383](https://tree.taiga.io/project/penpot/issue/2383)
- Fix handoff text with opacity [Taiga #2384](https://tree.taiga.io/project/penpot/issue/2384)
- Restored rules color [Taiga #2460](https://tree.taiga.io/project/penpot/issue/2460)
- Fix thumbnail not taking frame blending mode [Taiga #2301](https://tree.taiga.io/project/penpot/issue/2301)
- Fix import/export with SVG edge cases [Taiga #2389](https://tree.taiga.io/project/penpot/issue/2389)
- Avoid modifying component when moving into a group [Taiga #2534](https://tree.taiga.io/project/penpot/issue/2534)
- Show correctly group types label in handoff [Taiga #2482](https://tree.taiga.io/project/penpot/issue/2482)
- Display view mode buttons always centered in viewer [#Taiga 2466](https://tree.taiga.io/project/penpot/issue/2466)
- Fix default profile image generation issue [Taiga #2601](https://tree.taiga.io/project/penpot/issue/2601)
- Fix edit blur attributes for multiselection [Taiga #2625](https://tree.taiga.io/project/penpot/issue/2625)
- Fix auto hide header in viewer full screen [Taiga #2632](https://tree.taiga.io/project/penpot/issue/2632)
- Fix zoom in/out after fit or fill [Taiga #2630](https://tree.taiga.io/project/penpot/issue/2630)
- Normalize zoom levels in workspace and viewer [Taiga #2631](https://tree.taiga.io/project/penpot/issue/2631)
- Avoid empty names in projects, files and pages [Taiga #2594](https://tree.taiga.io/project/penpot/issue/2594)
- Fix "move to" menu when duplicated team or project names [Taiga #2655](https://tree.taiga.io/project/penpot/issue/2655)
- Fix ungroup a component leaves an asterisk in layers [Taiga #2694](https://tree.taiga.io/project/penpot/issue/2694)
### :arrow_up: Deps updates
- Update devenv docker image dependencies.
### :heart: Community contributions by (Thank you!)
- Spelling fixes (by @jsoref) [#1340](https://github.com/penpot/penpot/pull/1340)
- Explain folders in components (by @candideu) [Penpot-docs #42](https://github.com/penpot/penpot-docs/pull/42)
- Readability improvements of user guide (by @PaulSchulz) [Penpot-docs #50](https://github.com/penpot/penpot-docs/pull/50)
# 1.10.4-beta
## 1.10.4-beta
### :sparkles: Enhacements
@ -21,8 +101,7 @@
- Minor fix on how file changes log is persisted.
- Fix many issues on error reporting.
# 1.10.3-beta
## 1.10.3-beta
### :sparkles: Enhacements
@ -33,7 +112,7 @@
- Fix unexpected exception on saving pages with default grids [#2409](https://tree.taiga.io/project/penpot/issue/2409)
- Fix react warnings on setting size 1 on row and column grids.
- Fix minor issues on ZMQ logging listener (used in error reporting service).
- Fix minor issues on ZMQ logging listener (used in error reporting service)
- Remove "ALPHA" from the code.
- Fix value and nil handling on numeric-input component. This fixes many issues related to typography, components, etc. renaming.
- Fix NPE on email complains processing.
@ -44,8 +123,7 @@
- Update log4j2 dependency.
# 1.10.2-beta
## 1.10.2-beta
### :bug: Bugs fixed
@ -57,14 +135,12 @@
- Update log4j2 dependency.
# 1.10.1-beta
## 1.10.1-beta
### :bug: Bugs fixed
- Fix problems with team management [#1353](https://github.com/penpot/penpot/issues/1353)
## 1.10.0-beta
### :boom: Breaking changes
@ -76,18 +152,19 @@
### :sparkles: New features
- Enhance corner radius behavior [Taiga #2190](https://tree.taiga.io/project/penpot/issue/2190).
- Allow preserve scroll position in interactions [Taiga #2250](https://tree.taiga.io/project/penpot/us/2250).
- Allow ungroup groups in bulk [Taiga #2211](https://tree.taiga.io/project/penpot/us/2211)
- Enhance corner radius behavior [Taiga #2190](https://tree.taiga.io/project/penpot/issue/2190)
- Allow preserve scroll position in interactions [Taiga #2250](https://tree.taiga.io/project/penpot/us/2250)
- Add new onboarding modals.
### :bug: Bugs fixed
- Fix problem with exporting before the document is saved [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189).
- Fix undo stacking when changing color from color-picker [Taiga #2191](https://tree.taiga.io/project/penpot/issue/2191).
- Fix pages dropdown in viewer [Taiga #2087](https://tree.taiga.io/project/penpot/issue/2087).
- Fix problem when exporting texts with gradients or opacity [Taiga #2200](https://tree.taiga.io/project/penpot/issue/2200).
- Fix problem with view mode comments [Taiga #2226](https://tree.taiga.io/project/penpot/issue/2226).
- Disallow to create a component when already has one [Taiga #2237](https://tree.taiga.io/project/penpot/issue/2237).
- Fix problem with exporting before the document is saved [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189)
- Fix undo stacking when changing color from color-picker [Taiga #2191](https://tree.taiga.io/project/penpot/issue/2191)
- Fix pages dropdown in viewer [Taiga #2087](https://tree.taiga.io/project/penpot/issue/2087)
- Fix problem when exporting texts with gradients or opacity [Taiga #2200](https://tree.taiga.io/project/penpot/issue/2200)
- Fix problem with view mode comments [Taiga #2226](https://tree.taiga.io/project/penpot/issue/2226)
- Disallow to create a component when already has one [Taiga #2237](https://tree.taiga.io/project/penpot/issue/2237)
- Add ellipsis in long labels for input fields [Taiga #2224](https://tree.taiga.io/project/penpot/issue/2224)
- Fix problem with text rendering on export [Taiga #2223](https://tree.taiga.io/project/penpot/issue/2223)
- Fix problem when flattening booleans losing styles [Taiga #2217](https://tree.taiga.io/project/penpot/issue/2217)
@ -100,61 +177,66 @@
- Add placeholder to create shareable link
- Fix project files count not refreshing correctly after import [Taiga #2216](https://tree.taiga.io/project/penpot/issue/2216)
- Remove button after import process finish [Taiga #2215](https://tree.taiga.io/project/penpot/issue/2215)
- Fix problem with styles in the viewer [Taiga #2467](https://tree.taiga.io/project/penpot/issue/2467)
- Fix default state in viewer [Taiga #2465](https://tree.taiga.io/project/penpot/issue/2465)
- Fix division by zero in bool operation [Taiga #2349](https://tree.taiga.io/project/penpot/issue/2349)
### :heart: Community contributions by (Thank you!)
- To the translation community for the hard work on making penpot
available on so many languages.
- Guide to integrate with Azure Directory (by @skrzyneckik) [Penpot-docs #33](https://github.com/penpot/penpot-docs/pull/33)
- Improve libraries section readability (by @PaulSchulz) [Penpot-docs #39](https://github.com/penpot/penpot-docs/pull/39)
## 1.9.0-alpha
### :boom: Breaking changes
- Some stroke-caps can change behaviour.
- Text display bug fix could potentialy make some texts jump a line.
- Text display bug fix could potentially make some texts jump a line.
### :sparkles: New features
- Add boolean shapes: intersections, unions, difference and exclusions[Taiga #748](https://tree.taiga.io/project/penpot/us/748).
- Add advanced prototyping [Taiga #244](https://tree.taiga.io/project/penpot/us/244).
- Add multiple flows [Taiga #2091](https://tree.taiga.io/project/penpot/us/2091).
- Add boolean shapes: intersections, unions, difference and exclusions[Taiga #748](https://tree.taiga.io/project/penpot/us/748)
- Add advanced prototyping [Taiga #244](https://tree.taiga.io/project/penpot/us/244)
- Add multiple flows [Taiga #2091](https://tree.taiga.io/project/penpot/us/2091)
- Change order of the teams menu so it's in the joined time order.
### :bug: Bugs fixed
- Enhance duplicating prototype connections behaviour [Taiga #2093](https://tree.taiga.io/project/penpot/us/2093).
- Ignore constraints in horizontal or vertical flip [Taiga #2038](https://tree.taiga.io/project/penpot/issue/2038).
- Fix color and typographies refs lost when duplicated file [Taiga #2165](https://tree.taiga.io/project/penpot/issue/2165).
- Fix problem with overflow dropdown on stroke-cap [#1216](https://github.com/penpot/penpot/issues/1216).
- Fix menu context for single element nested in components [#1186](https://github.com/penpot/penpot/issues/1186).
- Fix error screen when operations over comments fail [#1219](https://github.com/penpot/penpot/issues/1219).
- Fix undo problem when changing typography/color from library [#1230](https://github.com/penpot/penpot/issues/1230).
- Fix problem with text margin while rendering [#1231](https://github.com/penpot/penpot/issues/1231).
- Fix problem with masked texts on exporting [Taiga #2116](https://tree.taiga.io/project/penpot/issue/2116).
- Fix text editor enter behaviour with centered texts [Taiga #2126](https://tree.taiga.io/project/penpot/issue/2126).
- Fix residual stroke on imported svg [Taiga #2125](https://tree.taiga.io/project/penpot/issue/2125).
- Add links for terms of service and privacy policy in register checkbox [Taiga #2020](https://tree.taiga.io/project/penpot/issue/2020).
- Allow three character hex and web colors in color picker hex input [#1184](https://github.com/penpot/penpot/issues/1184).
- Allow lowercase search for fonts [#1180](https://github.com/penpot/penpot/issues/1180).
- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969).
- Fix export group with shadows on children [Taiga #2036](https://tree.taiga.io/project/penpot/issue/2036).
- Fix zoom context menu in viewer [Taiga #2041](https://tree.taiga.io/project/penpot/issue/2041).
- Fix stroke caps adjustments in relation with stroke size [Taiga #2123](https://tree.taiga.io/project/penpot/issue/2123).
- Fix problem duplicating paths [Taiga #2147](https://tree.taiga.io/project/penpot/issue/2147).
- Fix problem inheriting attributes from SVG root when importing [Taiga #2124](https://tree.taiga.io/project/penpot/issue/2124).
- Fix problem with lines and inside/outside stroke [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146).
- Add stroke width in selection calculation [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146).
- Fix shift+wheel to horizontal scrolling in MacOS [#1217](https://github.com/penpot/penpot/issues/1217).
- Fix path stroke is not working properly with high thickness [Taiga #2154](https://tree.taiga.io/project/penpot/issue/2154).
- Fix bug with transformation operations [Taiga #2155](https://tree.taiga.io/project/penpot/issue/2155).
- Fix bug in firefox when a text box is inside a mask [Taiga #2152](https://tree.taiga.io/project/penpot/issue/2152).
- Enhance duplicating prototype connections behaviour [Taiga #2093](https://tree.taiga.io/project/penpot/us/2093)
- Ignore constraints in horizontal or vertical flip [Taiga #2038](https://tree.taiga.io/project/penpot/issue/2038)
- Fix color and typographies refs lost when duplicated file [Taiga #2165](https://tree.taiga.io/project/penpot/issue/2165)
- Fix problem with overflow dropdown on stroke-cap [#1216](https://github.com/penpot/penpot/issues/1216)
- Fix menu context for single element nested in components [#1186](https://github.com/penpot/penpot/issues/1186)
- Fix error screen when operations over comments fail [#1219](https://github.com/penpot/penpot/issues/1219)
- Fix undo problem when changing typography/color from library [#1230](https://github.com/penpot/penpot/issues/1230)
- Fix problem with text margin while rendering [#1231](https://github.com/penpot/penpot/issues/1231)
- Fix problem with masked texts on exporting [Taiga #2116](https://tree.taiga.io/project/penpot/issue/2116)
- Fix text editor enter behaviour with centered texts [Taiga #2126](https://tree.taiga.io/project/penpot/issue/2126)
- Fix residual stroke on imported svg [Taiga #2125](https://tree.taiga.io/project/penpot/issue/2125)
- Add links for terms of service and privacy policy in register checkbox [Taiga #2020](https://tree.taiga.io/project/penpot/issue/2020)
- Allow three character hex and web colors in color picker hex input [#1184](https://github.com/penpot/penpot/issues/1184)
- Allow lowercase search for fonts [#1180](https://github.com/penpot/penpot/issues/1180)
- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969)
- Fix export group with shadows on children [Taiga #2036](https://tree.taiga.io/project/penpot/issue/2036)
- Fix zoom context menu in viewer [Taiga #2041](https://tree.taiga.io/project/penpot/issue/2041)
- Fix stroke caps adjustments in relation with stroke size [Taiga #2123](https://tree.taiga.io/project/penpot/issue/2123)
- Fix problem duplicating paths [Taiga #2147](https://tree.taiga.io/project/penpot/issue/2147)
- Fix problem inheriting attributes from SVG root when importing [Taiga #2124](https://tree.taiga.io/project/penpot/issue/2124)
- Fix problem with lines and inside/outside stroke [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146)
- Add stroke width in selection calculation [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146)
- Fix shift+wheel to horizontal scrolling in MacOS [#1217](https://github.com/penpot/penpot/issues/1217)
- Fix path stroke is not working properly with high thickness [Taiga #2154](https://tree.taiga.io/project/penpot/issue/2154)
- Fix bug with transformation operations [Taiga #2155](https://tree.taiga.io/project/penpot/issue/2155)
- Fix bug in firefox when a text box is inside a mask [Taiga #2152](https://tree.taiga.io/project/penpot/issue/2152)
- Fix problem with stroke inside/outside [Taiga #2186](https://tree.taiga.io/project/penpot/issue/2186)
- Fix masks export area [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189)
- Fix paste in place in arboards [Taiga #2188](https://tree.taiga.io/project/penpot/issue/2188)
- Fix paste in place in artboards [Taiga #2188](https://tree.taiga.io/project/penpot/issue/2188)
- Fix font size input stuck on selection change [Taiga #2184](https://tree.taiga.io/project/penpot/issue/2184)
- Fix stroke cut on shapes export [Taiga #2171](https://tree.taiga.io/project/penpot/issue/2171)
- Fix no color when boolean with an SVG [Taiga #2193](https://tree.taiga.io/project/penpot/issue/2193)
- Fix unlink color styles at strokes [Taiga #2206](https://tree.taiga.io/project/penpot/issue/2206).
- Fix unlink color styles at strokes [Taiga #2206](https://tree.taiga.io/project/penpot/issue/2206)
### :arrow_up: Deps updates
@ -163,13 +245,11 @@
- To the translation community for the hard work on making penpot
available on so many languages.
## 1.8.4-alpha
### :bug: Bugs fixed
- Fix problem importing components [Taiga #2151](https://tree.taiga.io/project/penpot/issue/2151).
- Fix problem importing components [Taiga #2151](https://tree.taiga.io/project/penpot/issue/2151)
## 1.8.3-alpha
@ -181,18 +261,17 @@
### :bug: Bugs fixed
- Fix problem with masking images in viewer [#1238](https://github.com/penpot/penpot/issues/1238).
- Fix problem with masking images in viewer [#1238](https://github.com/penpot/penpot/issues/1238)
## 1.8.1-alpha
### :bug: Bugs fixed
- Fix project renaming issue (and some other related to the same underlying bug).
- Fix project renaming issue (and some other related to the same underlying bug)
- Fix internal exception on audit log persistence layer.
- Set proper environment variable on docker images for chrome executable.
- Fix internal metrics on websocket connections.
## 1.8.0-alpha
### :boom: Breaking changes
@ -203,25 +282,25 @@
### :sparkles: New features
- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814).
- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107).
- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428).
- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386).
- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883).
- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895).
- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374).
- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047).
- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799).
- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921).
- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823).
- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800).
- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550).
- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844).
- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814)
- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107)
- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428)
- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386)
- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883)
- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895)
- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374)
- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047)
- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799)
- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921)
- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823)
- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800)
- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550)
- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844)
### :bug: Bugs fixed
- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929).
- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935).
- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929)
- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935)
- Fix problem with zoom and selection [Taiga #1919](https://tree.taiga.io/project/penpot/issue/1919)
- Fix problem with borders on shape export [#1092](https://github.com/penpot/penpot/issues/1092)
- Fix thumbnail cropping issue [Taiga #1964](https://tree.taiga.io/project/penpot/issue/1964)
@ -234,11 +313,12 @@
- Fix problem while moving imported SVG's [#1199](https://github.com/penpot/penpot/issues/1199)
### :arrow_up: Deps updates
### :boom: Breaking changes
### :heart: Community contributions by (Thank you!)
- eduayme [#1129](https://github.com/penpot/penpot/pull/1129).
- eduayme [#1129](https://github.com/penpot/penpot/pull/1129)
## 1.7.4-alpha
@ -247,14 +327,12 @@
- Fix demo user creation (self-hosted only)
- Add better ldap response validation and reporting (self-hosted only)
## 1.7.3-alpha
### :bug: Bugs fixed
- Fix font uploading issue on Windows.
## 1.7.2-alpha
### :sparkles: New features
@ -263,8 +341,8 @@
### :bug: Bugs fixed
- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894).
- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892).
- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894)
- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892)
- Fix properly messages lifecycle on navigate.
- Fix handling repeated names on duplicate object trees.
- Fix group naming on group creation.
@ -278,7 +356,6 @@
- soultipsy [#1100](https://github.com/penpot/penpot/pull/1100)
## 1.7.1-alpha
### :bug: Bugs fixed
@ -288,19 +365,18 @@
- Fix issue on undo page deletion.
- Fix some issues related to constraints.
## 1.7.0-alpha
### :sparkles: New features
- Allow nested asset groups [Taiga #1716](https://tree.taiga.io/project/penpot/us/1716).
- Allow to ungroup assets [Taiga #1719](https://tree.taiga.io/project/penpot/us/1719).
- Allow to rename assets groups [Taiga #1721](https://tree.taiga.io/project/penpot/us/1721).
- Component constraints (left, right, left and right, center, scale...) [Taiga #1125](https://tree.taiga.io/project/penpot/us/1125).
- Export elements to PDF [Taiga #519](https://tree.taiga.io/project/penpot/us/519).
- Memorize collapse state of assets in panel [Taiga #1718](https://tree.taiga.io/project/penpot/us/1718).
- Headers button sets and menus review [Taiga #1663](https://tree.taiga.io/project/penpot/us/1663).
- Preserve components if possible, when pasted into a different file [Taiga #1063](https://tree.taiga.io/project/penpot/issue/1063).
- Allow nested asset groups [Taiga #1716](https://tree.taiga.io/project/penpot/us/1716)
- Allow to ungroup assets [Taiga #1719](https://tree.taiga.io/project/penpot/us/1719)
- Allow to rename assets groups [Taiga #1721](https://tree.taiga.io/project/penpot/us/1721)
- Component constraints (left, right, left and right, center, scale...) [Taiga #1125](https://tree.taiga.io/project/penpot/us/1125)
- Export elements to PDF [Taiga #519](https://tree.taiga.io/project/penpot/us/519)
- Memorize collapse state of assets in panel [Taiga #1718](https://tree.taiga.io/project/penpot/us/1718)
- Headers button sets and menus review [Taiga #1663](https://tree.taiga.io/project/penpot/us/1663)
- Preserve components if possible, when pasted into a different file [Taiga #1063](https://tree.taiga.io/project/penpot/issue/1063)
- Add the ability to offload file data to a cheaper storage when file becomes inactive.
- Import/Export Penpot files from dashboard.
- Double click won't make a shape a path until you change a node [Taiga #1796](https://tree.taiga.io/project/penpot/us/1796)
@ -309,21 +385,20 @@
### :bug: Bugs fixed
- Process numeric input changes only if the value actually changed.
- Remove unnecesary redirect from history when user goes to workspace from dashboard [Taiga #1820](https://tree.taiga.io/project/penpot/issue/1820).
- Detach shapes from deleted assets [Taiga #1850](https://tree.taiga.io/project/penpot/issue/1850).
- Fix tooltip position on view application [Taiga #1819](https://tree.taiga.io/project/penpot/issue/1819).
- Fix dashboard navigation on moving file to other team [Taiga #1817](https://tree.taiga.io/project/penpot/issue/1817).
- Fix workspace header presence styles and invalid link [Taiga #1813](https://tree.taiga.io/project/penpot/issue/1813).
- Fix color-input wrong behavior (on workspace page color) [Taiga #1795](https://tree.taiga.io/project/penpot/issue/1795).
- Fix file contextual menu in shared libraries at dashboard [Taiga #1865](https://tree.taiga.io/project/penpot/issue/1865).
- Remove unnecessary redirect from history when user goes to workspace from dashboard [Taiga #1820](https://tree.taiga.io/project/penpot/issue/1820)
- Detach shapes from deleted assets [Taiga #1850](https://tree.taiga.io/project/penpot/issue/1850)
- Fix tooltip position on view application [Taiga #1819](https://tree.taiga.io/project/penpot/issue/1819)
- Fix dashboard navigation on moving file to other team [Taiga #1817](https://tree.taiga.io/project/penpot/issue/1817)
- Fix workspace header presence styles and invalid link [Taiga #1813](https://tree.taiga.io/project/penpot/issue/1813)
- Fix color-input wrong behavior (on workspace page color) [Taiga #1795](https://tree.taiga.io/project/penpot/issue/1795)
- Fix file contextual menu in shared libraries at dashboard [Taiga #1865](https://tree.taiga.io/project/penpot/issue/1865)
- Fix problem with color picker and fonts [#1049](https://github.com/penpot/penpot/issues/1049)
- Fix negative values in blur [Taiga #1815](https://tree.taiga.io/project/penpot/issue/1815)
- Fix problem when editing color in group [Taiga #1816](https://tree.taiga.io/project/penpot/issue/1816)
- Fix resize/rotate with mouse buttons different than left [#1060](https://github.com/penpot/penpot/issues/1060)
- Fix header partialy visible on fullscreen viewer mode [Taiga #1875](https://tree.taiga.io/project/penpot/issue/1875)
- Fix header partially visible on fullscreen viewer mode [Taiga #1875](https://tree.taiga.io/project/penpot/issue/1875)
- Fix dynamic alignment enabled with hidden objects [#1063](https://github.com/penpot/penpot/issues/1063)
## 1.6.5-alpha
### :bug: Bugs fixed
@ -334,8 +409,8 @@
### :sparkles: Minor improvements
- Decrease default bulk buffers on storage tasks.
- Reduce file_change preserve interval to 24h.
- Decrease default bulk buffers on storage tasks.
- Reduce file_change preserve interval to 24h.
### :bug: Bugs fixed
@ -348,7 +423,6 @@
- Properly handle nil values on `update-shapes` function.
- Replace frame term usage by artboard on viewer app.
## 1.6.3-alpha
### :bug: Bugs fixed
@ -375,42 +449,39 @@
- Minor fix on previous commit.
- Minor improvements on svg uploading on libraries.
## 1.6.1-alpha
### :bug: Bugs fixed
- Add safety check on reg-objects change impl.
- Fix custom fonts embbedding issue.
- Fix custom fonts embedding issue.
- Fix dashboard ordering issue.
- Fix problem when creating a component with empty data.
- Fix problem with moving shapes into frames.
- Fix problems with mov-objects.
- Fix unexpected excetion related to rounding integers.
- Fix unexpected exception related to rounding integers.
- Fix wrong type usage on libraries changes.
- Improve editor lifecycle management.
- Make the navigation async by default.
## 1.6.0-alpha
### :sparkles: New features
- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292)
- Add option to interactively scale text [Taiga #1527](https://tree.taiga.io/project/penpot/us/1527)
- Add performance improvements on dashboard data loading.
- Add performance improvements to indexes handling on workspace.
- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292)
- Transform shapes to path on double click
- Translate automatic names of new files and projects.
- Use shift instead of ctrl/cmd to keep aspect ratio [Taiga 1697](https://tree.taiga.io/project/penpot/issue/1697).
- New translations: Portuguese (Brazil) and Romanias.
- Use shift instead of ctrl/cmd to keep aspect ratio [Taiga 1697](https://tree.taiga.io/project/penpot/issue/1697)
- New translations: Portuguese (Brazil) and Romanias.
### :bug: Bugs fixed
- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656).
- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940).
- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656)
- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940)
- Fix problem with imported SVG on editing paths [#971](https://github.com/penpot/penpot/issues/971)
- Fix problem with color picker positioning
- Fix order on color palette [#961](https://github.com/penpot/penpot/issues/961)
@ -424,7 +495,6 @@
- Update exporter dependencies (puppeteer), that fixes some unexpected exceptions.
- Update string manipulation library.
### :boom: Breaking changes
- The OIDC setting `PENPOT_OIDC_SCOPES` has changed the default semantics. Before this
@ -435,7 +505,6 @@
- Translations: Portuguese (Brazil) and Romanias.
## 1.5.4-alpha
### :bug: Bugs fixed
@ -443,7 +512,6 @@
- Fix issues on group rendering.
- Fix problem with text editing auto-height [Taiga #1683](https://tree.taiga.io/project/penpot/issue/1683)
## 1.5.3-alpha
### :bug: Bugs fixed
@ -467,7 +535,6 @@
- Increase default team invitation token expiration to 48h.
- Fix wrong error message when an expired token is used.
## 1.5.0-alpha
### :sparkles: New features
@ -513,7 +580,6 @@
- madmath03 (by [Monogramm](https://github.com/Monogramm)) [#807](https://github.com/penpot/penpot/pull/807)
- zzkt [#814](https://github.com/penpot/penpot/pull/814)
## 1.4.1-alpha
### :bug: Bugs fixed
@ -525,7 +591,6 @@
- Fix incorrect state management of user lang selection.
- Fix email validation usability issue on team invitation lightbox.
## 1.4.0-alpha
### :sparkles: New features
@ -534,7 +599,7 @@
- Add http caching layer on top of Query RPC.
- Add layer opacity and blend mode to shapes [Taiga #937](https://tree.taiga.io/project/penpot/us/937)
- Add more chinese translations [#726](https://github.com/penpot/penpot/pull/726)
- Add native support for text-direction (RTL, LTR & auto).
- Add native support for text-direction (RTL, LTR & auto)
- Add several enhancements in shape selection [Taiga #1195](https://tree.taiga.io/project/penpot/us/1195)
- Add thumbnail in memory caching mechanism.
- Add turkish translation strings [#759](https://github.com/penpot/penpot/pull/759), [#794](https://github.com/penpot/penpot/pull/794)
@ -542,13 +607,12 @@
- Hide viewer navbar on fullscreen [Taiga 1375](https://tree.taiga.io/project/penpot/us/1375)
- Import SVG will create Penpot's shapes [Taiga #1006](https://tree.taiga.io/project/penpot/us/1066)
- Improve french translations [#731](https://github.com/penpot/penpot/pull/731)
- Reimplement workspace presence (remove database state).
- Reimplement workspace presence (remove database state)
- Remember last visited team when you re-enter the application [Taiga #1376](https://tree.taiga.io/project/penpot/us/1376)
- Rename artboard with double click on the title [Taiga #1392](https://tree.taiga.io/project/penpot/us/1392)
- Replace Slate-Editor with DraftJS [Taiga #1346](https://tree.taiga.io/project/penpot/us/1346)
- Set proper page title [Taiga #1377](https://tree.taiga.io/project/penpot/us/1377)
### :bug: Bugs fixed
- Disable buttons in view mode for users without permissions [Taiga #1328](https://tree.taiga.io/project/penpot/issue/1328)
@ -589,15 +653,13 @@
- The LDAP configuration variables interpolation starts using `:`
(example `:username`) instead of `$`. The main reason is avoid
unnecesary conflict with bash interpolation.
unnecessary conflict with bash interpolation.
### :arrow_up: Deps updates
- Update backend to JDK16.
- Update exporter nodejs to v14.16.0
### :heart: Community contributions by (Thank you!)
- iblueer [#726](https://github.com/penpot/penpot/pull/726)
@ -605,27 +667,25 @@
- girafic [#748](https://github.com/penpot/penpot/pull/748)
- mbrksntrk [#794](https://github.com/penpot/penpot/pull/794)
## 1.3.0-alpha
### :sparkles: New features
- Add emailcatcher and ldap test containers to devenv. [#506](https://github.com/penpot/penpot/pull/506)
- Add major refactor of internal pubsub/redis code; improves scalability and performance [#640](https://github.com/penpot/penpot/pull/640)
- Add more chinese transtions [#687](https://github.com/penpot/penpot/pull/687)
- Add more chinese translations [#687](https://github.com/penpot/penpot/pull/687)
- Add more presets for artboard [#654](https://github.com/penpot/penpot/pull/654)
- Add optional loki integration [#645](https://github.com/penpot/penpot/pull/645)
- Add proper http session lifecycle handling.
- Allow to set border radius of each rect corner individually
- Bounce & Complaint handling [#635](https://github.com/penpot/penpot/pull/635)
- Disable groups interactions when holding "Ctrl" key (deep selection)
- New action in context menu to "edit" some shapes (binded to key "Enter")
- New action in context menu to "edit" some shapes (bound to key "Enter")
### :bug: Bugs fixed
- Add more improvements to french translation strings [#591](https://github.com/penpot/penpot/pull/591)
- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks).
- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks)
- Disables filters in masking elements (issue with Firefox rendering)
- Drawing tool will have priority over resize/rotate handlers [Taiga #1225](https://tree.taiga.io/project/penpot/issue/1225)
- Fix broken bounding box on editing paths [Taiga #1254](https://tree.taiga.io/project/penpot/issue/1254)
@ -639,16 +699,14 @@
- Have language change notification written in the new language [Taiga #1205](https://tree.taiga.io/project/penpot/issue/1205)
- Hide register screen when registration is disabled [#598](https://github.com/penpot/penpot/issues/598)
- Properly handle errors on github, gitlab and ldap auth backends.
- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider).
- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider)
- Refactor LDAP auth backend.
### :heart: Community contributions by (Thank you!)
- girafic [#538](https://github.com/penpot/penpot/pull/654)
- arkhi [#591](https://github.com/penpot/penpot/pull/591)
## 1.2.0-alpha
### :sparkles: New features
@ -663,7 +721,6 @@
- Show a pixel grid when zoom greater than 800% [#519](https://github.com/penpot/penpot/discussions/519)
- Fix behavior of select all command when there are objects outside frames [Taiga #1209](https://tree.taiga.io/project/penpot/issue/1209)
### :bug: Bugs fixed
- Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
@ -699,7 +756,6 @@
- Improved MacOS shortcuts and helpers
- Small changes to shape creation
## 1.0.0-alpha
Initial release

20
CONTRIBUTING.md
View File

@ -19,9 +19,9 @@ If you found a bug, please report it, as far as possible with:
- a browser and the browser version used
- a dev tools console exception stack trace (if it is available)
If you found a bug that you consider better discuse in private (for
If you found a bug that you consider better discuss in private (for
example: security bugs), consider first send an email to
`info@penpot.app`.
`support@penpot.app`.
**We don't have formal bug bounty program for security reports; this
is an open source application and your contribution will be recognized
@ -54,7 +54,7 @@ We will use the `easy fix` mark for tag for indicate issues that are
easy for beginners.
## Commit Message Guidelines ##
## Commit Guidelines ##
We have very precise rules over how our git commit messages can be formatted.
@ -78,7 +78,6 @@ Where type is:
- :ambulance: `:ambulance:` a commit that fixes critical bug
- :books: `:books:` a commit that improves or adds documentation
- :construction: `:construction:`: a wip commit
- :construction_worker: `:construction_worker:` a commit with CI related stuff
- :boom: `:boom:` a commit with breaking changes
- :wrench: `:wrench:` a commit for config updates
- :zap: `:zap:` a commit with performance improvements
@ -91,13 +90,14 @@ More info:
- https://gist.github.com/parmentf/035de27d6ed1dce0b36a
- https://gist.github.com/rxaviers/7360908
The subject should be:
- Use the imperative mood.
- Capitalize the first letter.
- Don't put a period at the end of the subject line.
- Put a blank line between the subject line and the body.
Each commit should have:
- A concise subject using imperative mood.
- The subject should have capitalized the first letter and without
period at the end.
- A blank line between the subject line and the body.
- An entry on the CHANGES.md file if applicable, referencing the
github or taiga issue/user-story using the these same rules.
## Code of conduct ##

6
README.md
View File

@ -70,9 +70,9 @@ You can ask and answer questions, have open-ended conversations, and follow alon
✉️ [Mail us](mailto:info@penpot.app)
💬 [Github discussions](https://github.com/penpot/penpot/discussions)
💬 [GitHub discussions](https://github.com/penpot/penpot/discussions)
🐞 [Github issues](mailto:info@penpot.apphttps://github.com/penpot/penpot/issues)
🐞 [GitHub issues](https://github.com/penpot/penpot/issues)
✍️️ [Gitter](https://gitter.im/penpot/community)
@ -81,7 +81,7 @@ You can ask and answer questions, have open-ended conversations, and follow alon
You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
Would you like to know more about Penpot? We recommend you to visit our youtube channel and learn more about the functionalities and possibilities of Penpot with our video tutorials.
🎞️ [Youtube channel](https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g)
🎞️ [YouTube channel](https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g)
## License ##

36
backend/build.clj Normal file
View File

@ -0,0 +1,36 @@
(ns build
(:refer-clojure :exclude [compile])
(:require
[clojure.tools.build.api :as b]
[clojure.java.io]))
(def class-dir "target/classes")
(def basis (b/create-basis {:project "deps.edn"}))
(def jar-file "target/penpot.jar")
(defn clean [_]
(b/delete {:path "target"}))
(defn jar [_]
(b/copy-dir
{:src-dirs ["src" "resources"]
:target-dir class-dir})
(b/compile-clj
{:basis basis
:src-dirs ["src"]
:class-dir class-dir})
(b/uber
{:class-dir class-dir
:uber-file jar-file
:main 'clojure.main
:exclude [#"goog.*" #"^javasist.*"]
:basis basis}))
(defn compile [_]
(b/javac
{:src-dirs ["dev/java"]
:class-dir class-dir
:basis basis
:javac-opts ["-source" "11" "-target" "11"]}))

60
backend/deps.edn
View File

@ -6,67 +6,71 @@
org.zeromq/jeromq {:mvn/version "0.5.2"}
com.taoensso/nippy {:mvn/version "3.1.1"}
com.github.luben/zstd-jni {:mvn/version "1.5.0-4"}
com.github.luben/zstd-jni {:mvn/version "1.5.1-1"}
org.clojure/data.fressian {:mvn/version "1.0.0"}
;; NOTE: don't upgrade to latest version, breaking change is
;; introduced on 0.10.0 that suffixes counters with _total if they
;; are not already has this suffix.
io.prometheus/simpleclient {:mvn/version "0.9.0"}
io.prometheus/simpleclient_hotspot {:mvn/version "0.9.0"}
io.prometheus/simpleclient_jetty {:mvn/version "0.9.0"
io.prometheus/simpleclient {:mvn/version "0.14.1"}
io.prometheus/simpleclient_hotspot {:mvn/version "0.14.1"}
io.prometheus/simpleclient_jetty {:mvn/version "0.14.1"
:exclusions [org.eclipse.jetty/jetty-server
org.eclipse.jetty/jetty-servlet]}
io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
io.prometheus/simpleclient_httpserver {:mvn/version "0.14.1"}
io.lettuce/lettuce-core {:mvn/version "6.1.5.RELEASE"}
io.lettuce/lettuce-core {:mvn/version "6.1.6.RELEASE"}
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
info.sunng/ring-jetty9-adapter {:mvn/version "0.15.2"}
com.github.seancorfield/next.jdbc {:mvn/version "1.2.709"}
funcool/yetti {:git/tag "v4.0" :git/sha "59ed2a7"
:git/url "https://github.com/funcool/yetti.git"
:exclusions [org.slf4j/slf4j-api]}
com.github.seancorfield/next.jdbc {:mvn/version "1.2.761"}
metosin/reitit-ring {:mvn/version "0.5.15"}
org.postgresql/postgresql {:mvn/version "42.2.23"}
com.zaxxer/HikariCP {:mvn/version "5.0.0"}
org.postgresql/postgresql {:mvn/version "42.3.1"}
com.zaxxer/HikariCP {:mvn/version "5.0.1"}
funcool/datoteka {:mvn/version "2.0.0"}
buddy/buddy-core {:mvn/version "1.10.1"}
buddy/buddy-hashers {:mvn/version "1.8.1"}
buddy/buddy-sign {:mvn/version "3.4.1"}
buddy/buddy-hashers {:mvn/version "1.8.158"}
buddy/buddy-sign {:mvn/version "3.4.333"}
org.jsoup/jsoup {:mvn/version "1.14.2"}
org.jsoup/jsoup {:mvn/version "1.14.3"}
org.im4java/im4java {:mvn/version "1.4.0"}
org.lz4/lz4-java {:mvn/version "1.8.0"}
org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
integrant/integrant {:mvn/version "0.8.0"}
io.sentry/sentry {:mvn/version "5.1.2"}
io.sentry/sentry {:mvn/version "5.5.2"}
;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
software.amazon.awssdk/s3 {:mvn/version "2.17.40"}}
software.amazon.awssdk/s3 {:mvn/version "2.17.111"}}
:paths ["src" "resources"]
:paths ["src" "resources" "target/classes"]
:aliases
{:dev
{:extra-deps
{com.bhauman/rebel-readline {:mvn/version "RELEASE"}
org.clojure/tools.namespace {:mvn/version "RELEASE"}
org.clojure/test.check {:mvn/version "RELEASE"}
org.clojure/data.csv {:mvn/version "1.0.0"}
com.clojure-goes-fast/clj-async-profiler {:mvn/version "0.5.1"}
criterium/criterium {:mvn/version "RELEASE"}
clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
org.clojure/data.csv {:mvn/version "RELEASE"}
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
mockery/mockery {:mvn/version "RELEASE"}}
:extra-paths ["test" "dev"]}
:build
{:extra-deps {io.github.clojure/tools.build {:git/tag "v0.7.4" :git/sha "ac442da"}}
:ns-default build}
:kaocha
{:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.887"}}
{:extra-deps {lambdaisland/kaocha {:mvn/version "RELEASE"}}
:main-opts ["-m" "kaocha.runner"]}
:test
{:extra-deps {io.github.cognitect-labs/test-runner
{:git/url "https://github.com/cognitect-labs/test-runner.git"
:git/sha "dd6da11611eeb87f08780a30ac8ea6012d4c05ce"}}
{:extra-paths ["test"]
:extra-deps
{io.github.cognitect-labs/test-runner
{:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
:exec-fn cognitect.test-runner.api/test}
:outdated

40
backend/dev/user.clj
View File

@ -7,12 +7,17 @@
(ns user
(:require
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.perf :as perf]
[app.common.transit :as t]
[app.config :as cfg]
[app.main :as main]
[app.util.blob :as blob]
[app.util.fressian :as fres]
[app.util.json :as json]
[app.util.time :as dt]
[app.util.transit :as t]
[clj-async-profiler.core :as prof]
[clojure.contrib.humanize :as hum]
[clojure.java.io :as io]
[clojure.pprint :refer [pprint print-table]]
[clojure.repl :refer :all]
@ -22,31 +27,14 @@
[clojure.test :as test]
[clojure.tools.namespace.repl :as repl]
[clojure.walk :refer [macroexpand-all]]
[criterium.core :refer [quick-bench bench with-progress-reporting]]
[datoteka.core]
[integrant.core :as ig]))
(repl/disable-reload! (find-ns 'integrant.core))
(set! *warn-on-reflection* true)
(defonce system nil)
;; --- Benchmarking Tools
(defmacro run-quick-bench
[& exprs]
`(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
(defmacro run-quick-bench'
[& exprs]
`(quick-bench (do ~@exprs)))
(defmacro run-bench
[& exprs]
`(with-progress-reporting (bench (do ~@exprs) :verbose)))
(defmacro run-bench'
[& exprs]
`(bench (do ~@exprs)))
;; --- Development Stuff
(defn- run-tests
@ -91,11 +79,13 @@
(defn compression-bench
[data]
(print-table
[{:v1 (alength (blob/encode data {:version 1}))
:v2 (alength (blob/encode data {:version 2}))
:v3 (alength (blob/encode data {:version 3}))}]))
(let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))]
(print-table
[{:v1 (humanize (alength (blob/encode data {:version 1})))
:v2 (humanize (alength (blob/encode data {:version 2})))
:v3 (humanize (alength (blob/encode data {:version 3})))
:v4 (humanize (alength (blob/encode data {:version 4})))
}])))
(defonce debug-tap
(do

94
backend/resources/error-list.tmpl
View File

@ -1,94 +0,0 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<meta name="robots" content="noindex,nofollow">
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<title>penpot - error report {{id}}</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
<style>
* {
font-family: "JetBrains Mono", monospace;
font-size: 12px;
}
body {
margin: 0px;
padding: 0px;
}
h1 {
padding: 0px;
margin: 0px;
font-size: 14px;
}
main {
margin: 20px;
margin-top: 40px;
}
nav {
position: fixed;
width: 100vw;
top: 0;
left: 0;
padding: 5px 20px;
display: flex;
background: #e3e3e3;
}
nav > div {
text-transform: uppercase;
font-weight: bold;
}
ul {
display: flex;
margin: 0px;
padding: 0px;
flex-direction: column;
flex-wrap: wrap;
height: calc(100vh - 75px);
justify-content: flex-start;
}
li {
list-style: none;
padding: 0px;
margin: 0px;
line-height: 18px;
min-width: 210px;
margin: 0px 20px;
cursor: pointer;
display: flex;
justify-content: center;
border-radius: 3px;
}
li:hover {
background-color: #e9e9e9;
}
li > a {
text-decoration: none;
color: inherit;
}
</style>
</head>
<body>
<nav>
<h1>Latest error reports:</h1>
</nav>
<main>
<ul>
{% for item in items %}
<li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
{% endfor %}
</ul>
</main>
</body>
</html>

154
backend/resources/error-report.tmpl
View File

@ -1,154 +0,0 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<meta name="robots" content="noindex,nofollow">
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<title>penpot - error report {{id}}</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
<style>
body {
margin: 0px;
padding: 0px;
}
pre {
margin: 0px;
line-height: 17px;
}
main {
margin: 20px;
}
nav {
position: fixed;
width: 100vw;
top: 0;
left: 0;
padding: 5px 20px;
display: flex;
background: #e3e3e3;
}
nav > div {
text-transform: uppercase;
font-weight: bold;
}
nav > div:not(:last-child) {
margin-right: 10px;
}
* {
font-family: "JetBrains Mono", monospace;
font-size: 12px;
}
.table {
margin-top: 25px;
display: flex;
flex-direction: column;
}
.table-row {
display: flex;
/* width: 100%; */
/* border: 1px solid red; */
}
.table-key {
font-weight: 600;
width: 60px;
padding: 4px;
padding-top: 40px;
margin-top: -40px;
}
.table-val {
font-weight: 200;
color: #333;
padding: 4px;
}
.multiline {
margin-top: 15px;
flex-direction: column;
}
.multiline .table-key {
margin-bottom: 10px;
border-bottom: 1px dashed #dddddd;
/* padding: 4px; */
width: unset;
}
</style>
</head>
<body>
<nav>
<div>[<a href="/dbg/error"><<</a>]</div>
<div>[<a href="#context">context</a>]</div>
<div>[<a href="#params">params</a>]</div>
{% if spec-problems %}
<div>[<a href="#edata">spec</a>]</div>
{% endif %}
{% if data %}
<div>[<a href="#edata">data</a>]</div>
{% endif %}
{% if trace %}
<div>[<a href="#trace">trace</a>]</div>
{% endif %}
</nav>
<main>
<div class="table">
<div class="table-row multiline">
<div id="context" class="table-key">CONTEXT: </div>
<div class="table-val">
<pre>{{context}}</pre>
</div>
</div>
{% if params %}
<div class="table-row multiline">
<div id="params" class="table-key">PARAMS: </div>
<div class="table-val">
<pre>{{params}}</pre>
</div>
</div>
{% endif %}
<!-- NOTE: this is legacy, for old error data saved on the database -->
{% if data %}
<div class="table-row multiline">
<div id="edata" class="table-key">ERROR DATA: </div>
<div class="table-val">
<pre>{{data}}</pre>
</div>
</div>
{% endif %}
{% if spec-problems %}
<div class="table-row multiline">
<div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
<div class="table-val">
<pre>{{spec-problems}}</pre>
</div>
</div>
{% endif %}
{% if trace %}
<div class="table-row multiline">
<div id="trace" class="table-key">TRACE:</div>
<div class="table-val">
<pre>{{trace}}</pre>
</div>
</div>
{% endif %}
</div>
</main>
</body>
</html>

2
backend/resources/log4j2.xml
View File

@ -2,7 +2,7 @@
<Configuration status="info" monitorInterval="60">
<Appenders>
<Console name="console" target="SYSTEM_OUT">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
</Console>
</Appenders>

18
backend/resources/templates/base.tmpl Normal file
View File

@ -0,0 +1,18 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<meta name="robots" content="noindex,nofollow">
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<title>{% block title %}{% endblock %}</title>
<link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
<style>
{% include "templates/styles.css" %}
</style>
</head>
<body>
{% block content %}
{% endblock %}
</body>
</html>

32
backend/resources/templates/debug.tmpl Normal file
View File

@ -0,0 +1,32 @@
{% extends "templates/base.tmpl" %}
{% block title %}
Debug Main Page
{% endblock %}
{% block content %}
<nav>
<h1>Debug INDEX:</h1>
<div>[<a href="/dbg/error">ERRORS</a>]</div>
</nav>
<main class="index">
<section>
<h2>Download file data:</h2>
<desc>Given an FILE-ID, downloads the file data as file. The file data is encoded using transit.</desc>
<form method="get" action="/dbg/file/data">
<input type="text" style="width:300px" name="file-id" placeholder="file-id" />
<input type="hidden" name="download" value="1" />
<input type="submit" value="Download" />
</form>
</section>
<section>
<h2>Upload File Data:</h2>
<desc>Create a new file on your draft projects using the file downloaded from the previous section.</desc>
<form method="post" enctype="multipart/form-data" action="/dbg/file/data">
<input type="file" name="file" value="" />
<input type="submit" value="Upload" />
</form>
</section>
</main>
{% endblock %}

18
backend/resources/templates/error-list.tmpl Normal file
View File

@ -0,0 +1,18 @@
{% extends "templates/base.tmpl" %}
{% block title %}
penpot - error list
{% endblock %}
{% block content %}
<nav>
<h1>Latest error reports:</h1>
</nav>
<main class="horizontal-list">
<ul>
{% for item in items %}
<li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
{% endfor %}
</ul>
</main>
{% endblock %}

98
backend/resources/templates/error-report.tmpl Normal file
View File

@ -0,0 +1,98 @@
{% extends "templates/base.tmpl" %}
{% block title %}
penpot - error report {{id}}
{% endblock %}
{% block content %}
<nav>
<div>[<a href="/dbg/error">⮜</a>]</div>
<div>[<a href="#context">context</a>]</div>
<div>[<a href="#params">request params</a>]</div>
{% if data %}
<div>[<a href="#edata">error data</a>]</div>
{% endif %}
{% if spec-explain %}
<div>[<a href="#spec-explain">spec explain</a>]</div>
{% endif %}
{% if spec-problems %}
<div>[<a href="#spec-problems">spec problems</a>]</div>
{% endif %}
{% if spec-value %}
<div>[<a href="#spec-value">spec value</a>]</div>
{% endif %}
{% if trace %}
<div>[<a href="#trace">error trace</a>]</div>
{% endif %}
</nav>
<main>
<div class="table">
<div class="table-row multiline">
<div id="context" class="table-key">CONTEXT: </div>
<div class="table-val">
<h1>{{hint}}</h1>
</div>
<div class="table-val">
<pre>{{context}}</pre>
</div>
</div>
{% if params %}
<div class="table-row multiline">
<div id="params" class="table-key">REQUEST PARAMS: </div>
<div class="table-val">
<pre>{{params}}</pre>
</div>
</div>
{% endif %}
{% if data %}
<div class="table-row multiline">
<div id="edata" class="table-key">ERROR DATA: </div>
<div class="table-val">
<pre>{{data}}</pre>
</div>
</div>
{% endif %}
{% if spec-explain %}
<div class="table-row multiline">
<div id="spec-explain" class="table-key">SPEC EXPLAIN: </div>
<div class="table-val">
<pre>{{spec-explain}}</pre>
</div>
</div>
{% endif %}
{% if spec-problems %}
<div class="table-row multiline">
<div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
<div class="table-val">
<pre>{{spec-problems}}</pre>
</div>
</div>
{% endif %}
{% if spec-value %}
<div class="table-row multiline">
<div id="spec-value" class="table-key">SPEC VALUE: </div>
<div class="table-val">
<pre>{{spec-value}}</pre>
</div>
</div>
{% endif %}
{% if trace %}
<div class="table-row multiline">
<div id="trace" class="table-key">TRACE:</div>
<div class="table-val">
<pre>{{trace}}</pre>
</div>
</div>
{% endif %}
</div>
</main>
{% endblock %}

150
backend/resources/templates/styles.css Normal file
View File

@ -0,0 +1,150 @@
* {
font-family: "JetBrains Mono", monospace;
font-size: 12px;
}
body {
margin: 0px;
padding: 0px;
}
pre {
margin: 0px;
line-height: 16px;
}
desc {
display: flex;
margin-bottom: 10px;
font-size: 10px;
color: #666;
}
input[type=text], input[type=submit] {
padding: 3px;
}
main {
margin: 20px;
}
nav {
position: fixed;
width: 100vw;
top: 0;
left: 0;
padding: 5px 20px;
display: flex;
background: #e3e3e3;
}
nav > h1 {
padding: 0px;
margin: 0px;
font-size: 11px;
}
nav > div {
text-transform: uppercase;
font-weight: bold;
}
nav > div:not(:last-child) {
margin-right: 10px;
}
.table {
margin-top: 25px;
display: flex;
flex-direction: column;
}
.table-row {
display: flex;
padding-bottom: 15px;
/* width: 100%; */
/* border: 1px solid red; */
}
.table-key {
font-weight: 600;
width: 60px;
padding: 4px;
padding-top: 40px;
margin-top: -40px;
}
.table-val {
font-weight: 200;
color: #333;
padding: 4px;
}
.multiline {
margin-top: 15px;
flex-direction: column;
}
.multiline .table-key {
margin-bottom: 10px;
border-bottom: 1px dashed #dddddd;
/* padding: 4px; */
width: unset;
}
.index {
margin-top: 40px;
}
.index > section {
padding: 10px;
background-color: #e3e3e3;
}
.index > section:not(:last-child) {
margin-bottom: 10px;
}
.index > section > h2 {
margin-top: 0px;
}
.horizontal-list {
margin: 20px;
margin-top: 40px;
}
.horizontal-list ul {
display: flex;
margin: 0px;
padding: 0px;
flex-direction: column;
flex-wrap: wrap;
height: calc(100vh - 75px);
justify-content: flex-start;
}
.horizontal-list li {
list-style: none;
padding: 0px;
margin: 0px;
line-height: 18px;
min-width: 210px;
margin: 0px 20px;
cursor: pointer;
display: flex;
justify-content: center;
border-radius: 3px;
}
.horizontal-list li:hover {
background-color: #e9e9e9;
}
.horizontal-list li > a {
text-decoration: none;
color: inherit;
}

85
backend/scripts/build
View File

@ -1,79 +1,20 @@
#!/usr/bin/env bb
#!/usr/bin/env bash
;; 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) UXBOX Labs SL
CURRENT_VERSION=$1;
(ns build
(:require
[clojure.string :as str]
[clojure.java.io :as io]
[clojure.pprint :refer [pprint]]
[babashka.fs :as fs]
[babashka.process :refer [$ check]]))
set -ex
(defn split-cp
[data]
(str/split data #":"))
rm -rf target;
mkdir -p target/classes;
mkdir -p target/dist;
echo "$CURRENT_VERSION" > target/classes/version.txt;
(def classpath
(->> ($ clojure -Spath)
(check)
(:out)
(slurp)
(split-cp)
(map str/trim)))
clojure -T:build jar;
mv target/penpot.jar target/dist/penpot.jar
cp scripts/run.template.sh target/dist/run.sh;
cp scripts/manage.template.sh target/dist/manage.sh;
chmod +x target/dist/run.sh;
chmod +x target/dist/manage.sh;
(def classpath-jars
(let [xfm (filter #(str/ends-with? % ".jar"))]
(into #{} xfm classpath)))
(def classpath-paths
(let [xfm (comp (remove #(str/ends-with? % ".jar"))
(filter #(.isDirectory (io/file %))))]
(into #{} xfm classpath)))
(def version
(or (first *command-line-args*) "%version%"))
;; Clean previous dist
(-> ($ rm -rf "./target/dist") check)
;; Create a new dist
(-> ($ mkdir -p "./target/dist/deps") check)
;; Copy all jar deps into dist
(run! (fn [item] (-> ($ cp ~item "./target/dist/deps/") check)) classpath-jars)
;; Create the application jar
(spit "./target/dist/version.txt" version)
(-> ($ jar cvf "./target/dist/deps/app.jar" -C ~(first classpath-paths) ".") check)
(-> ($ jar uvf "./target/dist/deps/app.jar" -C "./target/dist" "version.txt") check)
(run! (fn [item]
(-> ($ jar uvf "./target/dist/deps/app.jar" -C ~item ".") check))
(rest classpath-paths))
;; Copy logging configuration
(-> ($ cp "./resources/log4j2.xml" "./target/dist/") check)
;; Create classpath file
(let [jars (->> (into ["app.jar"] classpath-jars)
(map fs/file-name)
(map #(fs/path "deps" %))
(map str))]
(spit "./target/dist/classpath" (str/join ":" jars)))
;; Copy run script template
(-> ($ cp "./scripts/run.template.sh" "./target/dist/run.sh") check)
;; Copy run script template
(-> ($ cp "./scripts/manage.template.sh" "./target/dist/manage.sh") check)
;; Add exec permisions to scripts.
(-> ($ chmod +x "./target/dist/run.sh") check)
(-> ($ chmod +x "./target/dist/manage.sh") check)
nil

2
backend/scripts/manage.template.sh
View File

@ -16,4 +16,4 @@ if [ -f ./environ ]; then
source ./environ
fi
exec $JAVA_CMD $JVM_OPTS -classpath $(cat classpath) -Dlog4j2.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "$@"
exec $JAVA_CMD $JVM_OPTS -jar penpot.jar -m app.cli.manage "$@"

22
backend/scripts/repl
View File

@ -1,19 +1,25 @@
#!/usr/bin/env bash
export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
# export PENPOT_DATABASE_USERNAME="penpot"
# export PENPOT_DATABASE_PASSWORD="penpot"
# export PENPOT_DATABASE_READONLY=true
# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot_pre"
# export PENPOT_DATABASE_USERNAME="penpot_pre"
# export PENPOT_DATABASE_PASSWORD="penpot_pre"
# export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
export OPTIONS="
-A:jmx-remote:dev \
-A:dev \
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory \
-J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-J-XX:+UseShenandoahGC \
-J-XX:+UseZGC \
-J-XX:-OmitStackTraceInFastThrow \
-J-Xms50m -J-Xmx512m";
# export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
# export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
-J-Xms50m -J-Xmx1024m \
-J-Djdk.attach.allowAttachSelf \
-J-XX:+UnlockDiagnosticVMOptions \
-J-XX:+DebugNonSafepoints";
export OPTIONS_EVAL="nil"
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

2
backend/scripts/run.template.sh
View File

@ -17,4 +17,4 @@ if [ -f ./environ ]; then
fi
set -x
exec $JAVA_CMD $JVM_OPTS -classpath "$(cat classpath)" -Dlog4j2.configurationFile=./log4j2.xml "$@" clojure.main -m app.main
exec $JAVA_CMD $JVM_OPTS "$@" -jar penpot.jar -m app.main

3
backend/src/app/config.clj
View File

@ -42,6 +42,7 @@
(def defaults
{:http-server-port 6060
:http-server-host "localhost"
:host "devenv"
:tenant "dev"
:database-uri "postgresql://postgres/penpot"
@ -132,6 +133,7 @@
(s/def ::oidc-roles-attr ::us/keyword)
(s/def ::host ::us/string)
(s/def ::http-server-port ::us/integer)
(s/def ::http-server-host ::us/string)
(s/def ::http-session-idle-max-age ::dt/duration)
(s/def ::http-session-updater-batch-max-age ::dt/duration)
(s/def ::http-session-updater-batch-max-size ::us/integer)
@ -221,6 +223,7 @@
::oidc-roles-attr
::oidc-roles
::host
::http-server-host
::http-server-port
::http-session-idle-max-age
::http-session-updater-batch-max-age

4
backend/src/app/db.clj
View File

@ -96,8 +96,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def initsql
(str "SET statement_timeout = 200000;\n"
"SET idle_in_transaction_session_timeout = 200000;"))
(str "SET statement_timeout = 300000;\n"
"SET idle_in_transaction_session_timeout = 300000;"))
(defn- create-datasource-config
[{:keys [metrics read-only] :or {read-only false} :as cfg}]

112
backend/src/app/http.clj
View File

@ -12,91 +12,78 @@
[app.common.spec :as us]
[app.http.doc :as doc]
[app.http.errors :as errors]
[app.http.debug :as debug]
[app.http.middleware :as middleware]
[app.metrics :as mtx]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[reitit.ring :as rr]
[ring.adapter.jetty9 :as jetty])
[yetti.adapter :as yt])
(:import
org.eclipse.jetty.server.Server
org.eclipse.jetty.server.handler.ErrorHandler
org.eclipse.jetty.server.handler.StatisticsHandler))
(declare router-handler)
(declare wrap-router)
(s/def ::handler fn?)
(s/def ::router some?)
(s/def ::ws (s/map-of ::us/string fn?))
(s/def ::port ::us/integer)
(s/def ::host ::us/string)
(s/def ::name ::us/string)
(defmethod ig/pre-init-spec ::server [_]
(s/keys :req-un [::port]
:opt-un [::ws ::name ::mtx/metrics ::router ::handler]))
:opt-un [::name ::mtx/metrics ::router ::handler ::host]))
(defmethod ig/prep-key ::server
[_ cfg]
(merge {:name "http"} (d/without-nils cfg)))
(defn- instrument-metrics
[^Server server metrics]
(let [stats (doto (StatisticsHandler.)
(.setHandler (.getHandler server)))]
(.setHandler server stats)
(mtx/instrument-jetty! (:registry metrics) stats)
server))
(defmethod ig/init-key ::server
[_ {:keys [handler router ws port name metrics] :as opts}]
(l/info :msg "starting http server" :port port :name name)
(let [pre-start (fn [^Server server]
(let [handler (doto (ErrorHandler.)
(.setShowStacks true)
(.setServer server))]
(.setErrorHandler server ^ErrorHandler handler)
(when metrics
(let [stats (StatisticsHandler.)]
(.setHandler ^StatisticsHandler stats (.getHandler server))
(.setHandler server stats)
(mtx/instrument-jetty! (:registry metrics) stats)))))
options (merge
{:port port
:h2c? true
:join? false
:allow-null-path-info true
:configurator pre-start}
(when (seq ws)
{:websockets ws}))
handler (cond
(fn? handler) handler
(some? router) (router-handler router)
:else (ex/raise :type :internal
:code :invalid-argument
:hint "Missing `handler` or `router` option."))
server (jetty/run-jetty handler options)]
(assoc opts :server server)))
[_ {:keys [handler router port name metrics host] :as opts}]
(l/info :msg "starting http server" :port port :host host :name name)
(let [options {:http/port port :http/host host}
handler (cond
(fn? handler) handler
(some? router) (wrap-router router)
:else (ex/raise :type :internal
:code :invalid-argument
:hint "Missing `handler` or `router` option."))
server (-> (yt/server handler options)
(cond-> metrics (instrument-metrics metrics)))]
(assoc opts :server (yt/start! server))))
(defmethod ig/halt-key! ::server
[_ {:keys [server name port] :as opts}]
(l/info :msg "stoping http server"
:name name
:port port)
(jetty/stop-server server))
(l/info :msg "stoping http server" :name name :port port)
(yt/stop! server))
(defn- router-handler
(defn- wrap-router
[router]
(let [handler (rr/ring-handler router
(rr/routes
(rr/create-resource-handler {:path "/"})
(rr/create-default-handler))
{:middleware [middleware/server-timing]})]
(let [default (rr/routes
(rr/create-resource-handler {:path "/"})
(rr/create-default-handler))
options {:middleware [middleware/server-timing]}
handler (rr/ring-handler router default options)]
(fn [request]
(try
(handler request)
(catch Throwable e
(l/with-context (errors/get-error-context request e)
(l/error :hint (ex-message e) :cause e)
(l/error :hint "unexpected error processing request"
:query-string (:query-string request)
:cause e)
{:status 500 :body "internal server error"}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Http Main Handler (Router)
;; Http Router
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::rpc map?)
@ -105,16 +92,17 @@
(s/def ::storage map?)
(s/def ::assets map?)
(s/def ::feedback fn?)
(s/def ::ws fn?)
(s/def ::audit-http-handler fn?)
(s/def ::debug map?)
(defmethod ig/pre-init-spec ::router [_]
(s/keys :req-un [::rpc ::session ::mtx/metrics
(s/keys :req-un [::rpc ::session ::mtx/metrics ::ws
::oauth ::storage ::assets ::feedback
::debug ::audit-http-handler]))
(defmethod ig/init-key ::router
[_ {:keys [session rpc oauth metrics assets feedback debug] :as cfg}]
[_ {:keys [ws session rpc oauth metrics assets feedback debug] :as cfg}]
(rr/router
[["/metrics" {:get (:handler metrics)}]
["/assets" {:middleware [[middleware/format-response-body]
@ -125,27 +113,39 @@
["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
["/dbg" {:middleware [[middleware/params]
["/dbg" {:middleware [[middleware/multipart-params]
[middleware/params]
[middleware/keyword-params]
[middleware/format-response-body]
[middleware/errors errors/handle]
[middleware/cookies]
[(:middleware session)]]}
["" {:get (:index debug)}]
["/error-by-id/:id" {:get (:retrieve-error debug)}]
["/error/:id" {:get (:retrieve-error debug)}]
["/error" {:get (:retrieve-error-list debug)}]
["/file/data/:id" {:get (:retrieve-file-data debug)}]
["/file/changes/:id" {:get (:retrieve-file-changes debug)}]]
["/file/data" {:get (:retrieve-file-data debug)
:post (:upload-file-data debug)}]
["/file/changes" {:get (:retrieve-file-changes debug)}]]
["/webhooks"
["/sns" {:post (:sns-webhook cfg)}]]
["/ws/notifications"
{:middleware [[middleware/params]
[middleware/keyword-params]
[middleware/format-response-body]
[middleware/errors errors/handle]
[middleware/cookies]
[(:middleware session)]]
:get ws}]
["/api" {:middleware [[middleware/cors]
[middleware/etag]
[middleware/format-response-body]
[middleware/params]
[middleware/multipart-params]
[middleware/keyword-params]
[middleware/format-response-body]
[middleware/etag]
[middleware/parse-request-body]
[middleware/errors errors/handle]
[middleware/cookies]]}

4
backend/src/app/http/awsns.clj
View File

@ -173,14 +173,14 @@
(defn- process-report
[cfg {:keys [type profile-id] :as report}]
(l/trace :action "procesing report" :report (pr-str report))
(l/trace :action "processing report" :report (pr-str report))
(cond
;; In this case we receive a bounce/complaint notification without
;; confirmed identity, we just emit a warning but do nothing about
;; it because this is not a normal case. All notifications should
;; come with profile identity.
(nil? profile-id)
(l/warn :msg "a notification without identity recevied from AWS"
(l/warn :msg "a notification without identity received from AWS"
:report (pr-str report))
(= "bounce" type)

150
backend/src/app/http/debug.clj
View File

@ -9,26 +9,21 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.transit :as t]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.rpc.mutations.files :as m.files]
[app.rpc.queries.profile :as profile]
[app.util.blob :as blob]
[app.util.json :as json]
[app.util.template :as tmpl]
[app.util.time :as dt]
[clojure.java.io :as io]
[clojure.pprint :as ppr]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.core :as fs]
[integrant.core :as ig]))
(def sql:retrieve-range-of-changes
"select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
(def sql:retrieve-single-change
"select revn, changes, data from file_change where file_id=? and revn = ?")
;; (selmer.parser/cache-off!)
(defn authorized?
[pool {:keys [profile-id]}]
@ -37,66 +32,104 @@
admins (or (cf/get :admins) #{})]
(contains? admins (:email profile)))))
(defn prepare-response
[body]
(when-not body
(ex/raise :type :not-found
:code :enpty-data
:hint "empty response"))
{:status 200
:headers {"content-type" "application/transit+json"}
:body body})
(defn retrieve-file-data
(defn index
[{:keys [pool]} request]
(when-not (authorized? pool request)
(ex/raise :type :authentication
:code :only-admins-allowed))
(let [id (some-> (get-in request [:path-params :id]) uuid/uuid)
revn (some-> (get-in request [:params :revn]) d/parse-integer)]
(when-not id
(ex/raise :type :validation
:code :missing-arguments))
{:status 200
:headers {"content-type" "text/html"}
:body (-> (io/resource "templates/debug.tmpl")
(tmpl/render {}))})
(if (integer? revn)
(let [fchange (db/exec-one! pool [sql:retrieve-single-change id revn])]
(prepare-response (some-> fchange :data blob/decode)))
(let [file (db/get-by-id pool :file id)]
(prepare-response (some-> file :data blob/decode))))))
(def sql:retrieve-range-of-changes
"select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
(defn retrieve-file-changes
[{:keys [pool]} {:keys [params path-params profile-id] :as request}]
(def sql:retrieve-single-change
"select revn, changes, data from file_change where file_id=? and revn = ?")
(defn prepare-response
[{:keys [params] :as request} body]
(when-not body
(ex/raise :type :not-found
:code :enpty-data
:hint "empty response"))
(cond-> {:status 200
:headers {"content-type" "application/transit+json"}
:body body}
(contains? params :download)
(update :headers assoc "content-disposition" "attachment")))
(defn retrieve-file-data
[{:keys [pool]} {:keys [params] :as request}]
(when-not (authorized? pool request)
(ex/raise :type :authentication
:code :only-admins-allowed))
(let [id (some-> (get-in request [:path-params :id]) uuid/uuid)
revn (get-in request [:params :revn] "latest")]
(let [file-id (some-> (get-in request [:params :file-id]) uuid/uuid)
revn (some-> (get-in request [:params :revn]) d/parse-integer)]
(when-not file-id
(ex/raise :type :validation
:code :missing-arguments))
(when (or (not id) (not revn))
(let [data (if (integer? revn)
(some-> (db/exec-one! pool [sql:retrieve-single-change file-id revn]) :data)
(some-> (db/get-by-id pool :file file-id) :data))]
(if (contains? params :download)
(-> (prepare-response request data)
(update :headers assoc "content-type" "application/octet-stream"))
(prepare-response request (some-> data blob/decode))))))
(defn upload-file-data
[{:keys [pool]} {:keys [profile-id params] :as request}]
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
data (some-> params :file :tempfile fs/slurp-bytes blob/decode)]
(if (and data project-id)
(let [fname (str "imported-file-" (dt/now))]
(m.files/create-file pool {:id (uuid/next)
:name fname
:project-id project-id
:profile-id profile-id
:data data})
{:status 200
:body "OK"})
{:status 500
:body "error"})))
(defn retrieve-file-changes
[{:keys [pool]} request]
(when-not (authorized? pool request)
(ex/raise :type :authentication
:code :only-admins-allowed))
(let [file-id (some-> (get-in request [:params :id]) uuid/uuid)
revn (or (get-in request [:params :revn]) "latest")]
(when (or (not file-id) (not revn))
(ex/raise :type :validation
:code :invalid-arguments
:hint "missing arguments"))
(cond
(d/num-string? revn)
(let [item (db/exec-one! pool [sql:retrieve-single-change id (d/parse-integer revn)])]
(prepare-response (some-> item :changes blob/decode vec)))
(let [item (db/exec-one! pool [sql:retrieve-single-change file-id (d/parse-integer revn)])]
(prepare-response request (some-> item :changes blob/decode vec)))
(str/includes? revn ":")
(let [[start end] (->> (str/split revn #":")
(map str/trim)
(map d/parse-integer))
items (db/exec! pool [sql:retrieve-range-of-changes id start end])]
(prepare-response (some->> items
(map :changes)
(map blob/decode)
(mapcat identity)
(vec))))
items (db/exec! pool [sql:retrieve-range-of-changes file-id start end])]
(prepare-response request
(some->> items
(map :changes)
(map blob/decode)
(mapcat identity)
(vec))))
:else
(ex/raise :type :validation :code :invalid-arguments))))
@ -115,14 +148,19 @@
(render-template [report]
(binding [ppr/*print-right-margin* 300]
(let [context (dissoc report :trace :cause :params :data :spec-prob :spec-problems :error :explain)
(let [context (dissoc report
:trace :cause :params :data :spec-problems
:spec-explain :spec-value :error :explain :hint)
params {:context (with-out-str (ppr/pprint context))
:data (:data report)
:trace (or (:cause report)
(:trace report)
(some-> report :error :trace))
:params (:params report)}]
(-> (io/resource "error-report.tmpl")
:hint (:hint report)
:spec-explain (:spec-explain report)
:spec-problems (:spec-problems report)
:spec-value (:spec-value report)
:data (:data report)
:trace (or (:trace report)
(some-> report :error :trace))
:params (:params report)}]
(-> (io/resource "templates/error-report.tmpl")
(tmpl/render params)))))
]
@ -154,12 +192,14 @@
{:status 200
:headers {"content-type" "text/html; charset=utf-8"
"x-robots-tag" "noindex"}
:body (-> (io/resource "error-list.tmpl")
:body (-> (io/resource "templates/error-list.tmpl")
(tmpl/render {:items items}))}))
(defmethod ig/init-key ::handlers
[_ {:keys [pool] :as cfg}]
{:retrieve-file-data (partial retrieve-file-data cfg)
[_ cfg]
{:index (partial index cfg)
:retrieve-file-data (partial retrieve-file-data cfg)
:retrieve-file-changes (partial retrieve-file-changes cfg)
:retrieve-error (partial retrieve-error cfg)
:retrieve-error-list (partial retrieve-error-list cfg)})
:retrieve-error-list (partial retrieve-error-list cfg)
:upload-file-data (partial upload-file-data cfg)})

43
backend/src/app/http/errors.clj
View File

@ -12,7 +12,8 @@
[app.common.uuid :as uuid]
[clojure.pprint]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
[cuerdas.core :as str]
[expound.alpha :as expound]))
(defn- parse-client-ip
[{:keys [headers] :as request}]
@ -27,16 +28,22 @@
{:id (uuid/next)
:path (:uri request)
:method (:request-method request)
:hint (or (:hint data) (ex-message error))
:params (l/stringify-data (:params request))
:spec-problems (some-> data ::s/problems)
:data (some-> data (dissoc ::s/problems))
:hint (ex-message error)
:params (:params request)
:spec-problems (some->> data ::s/problems (take 10) seq vec)
:spec-value (some->> data ::s/value)
:data (some-> data (dissoc ::s/problems ::s/value ::s/spec))
:ip-addr (parse-client-ip request)
:profile-id (:profile-id request)}
(let [headers (:headers request)]
{:user-agent (get headers "user-agent")
:frontend-version (get headers "x-frontend-version" "unknown")}))))
:frontend-version (get headers "x-frontend-version" "unknown")})
(when (and data (::s/problems data))
{:spec-explain (binding [s/*explain-out* expound/printer]
(with-out-str
(s/explain-out (update data ::s/problems #(take 10 %)))))}))))
(defmulti handle-exception
(fn [err & _rest]
@ -54,18 +61,25 @@
(defmethod handle-exception :validation
[err _]
(let [edata (ex-data err)]
{:status 400 :body (dissoc edata ::s/problems)}))
(let [data (ex-data err)
explain (binding [s/*explain-out* expound/printer]
(with-out-str
(s/explain-out (update data ::s/problems #(take 10 %)))))]
{:status 400
:body (-> data
(dissoc ::s/problems)
(dissoc ::s/value)
(assoc :explain explain))}))
(defmethod handle-exception :assertion
[error request]
(let [edata (ex-data error)]
(l/with-context (get-error-context request error)
(l/error :hint (ex-message error) :cause error))
(l/error ::l/raw (ex-message error) :cause error))
{:status 500
:body {:type :server-error
:code :assertion
:data (dissoc edata ::s/problems)}}))
:data (dissoc edata ::s/problems ::s/value ::s/spec)}}))
(defmethod handle-exception :not-found
[err _]
@ -84,7 +98,7 @@
(handle-exception (:handling edata) request)
(do
(l/with-context (get-error-context request error)
(l/error :hint (ex-message error) :cause error))
(l/error ::l/raw (ex-message error) :cause error))
{:status 500
:body {:type :server-error
@ -97,10 +111,7 @@
(let [state (.getSQLState ^java.sql.SQLException error)]
(l/with-context (get-error-context request error)
(l/error :hint "psql exception"
:error-message (ex-message error)
:state state
:cause error))
(l/error ::l/raw (ex-message error) :cause error))
(cond
(= state "57014")

131
backend/src/app/http/middleware.clj
View File

@ -9,14 +9,15 @@
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.metrics :as mtx]
[app.util.json :as json]
[buddy.core.codecs :as bc]
[buddy.core.hash :as bh]
[ring.core.protocols :as rp]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.multipart-params :refer [wrap-multipart-params]]
[ring.middleware.params :refer [wrap-params]]))
[ring.middleware.params :refer [wrap-params]]
[yetti.adapter :as yt]))
(defn wrap-server-timing
[handler]
@ -35,52 +36,77 @@
(t/read! reader)))
(parse-json [body]
(json/read body))
(parse [type body]
(try
(case type
:json (parse-json body)
:transit (parse-transit body))
(catch Exception e
(let [data {:type :parse
:hint "unable to parse request body"
:message (ex-message e)}]
{:status 400
:headers {"content-type" "application/transit+json"}
:body (t/encode-str data {:type :json-verbose})}))))]
(json/read body))]
(fn [{:keys [headers body] :as request}]
(let [ctype (get headers "content-type")]
(handler
(case ctype
"application/transit+json"
(let [params (parse :transit body)]
(-> request
(assoc :body-params params)
(update :params merge params)))
(try
(let [ctype (get headers "content-type")]
(handler (case ctype
"application/transit+json"
(let [params (parse-transit body)]
(-> request
(assoc :body-params params)
(update :params merge params)))
"application/json"
(let [params (parse :json body)]
(-> request
(assoc :body-params params)
(update :params merge params)))
"application/json"
(let [params (parse-json body)]
(-> request
(assoc :body-params params)
(update :params merge params)))
request))))))
request)))
(catch Exception e
(let [data {:type :validation
:code :unable-to-parse-request-body
:hint "malformed params"}]
(l/error :hint (ex-message e) :cause e)
{:status 400
:headers {"content-type" "application/transit+json"}
:body (t/encode-str data {:type :json-verbose})}))))))
(def parse-request-body
{:name ::parse-request-body
:compile (constantly wrap-parse-request-body)})
(defn buffered-output-stream
"Returns a buffered output stream that ignores flush calls. This is
needed because transit-java calls flush very aggresivelly on each
object write."
[^java.io.OutputStream os ^long chunk-size]
(proxy [java.io.BufferedOutputStream] [os (int chunk-size)]
;; Explicitly do not forward flush
(flush [])
(close []
(proxy-super flush)
(proxy-super close))))
(def ^:const buffer-size (:http/output-buffer-size yt/base-defaults))
(defn- transit-streamable-body
[data opts]
(reify rp/StreamableResponseBody
(write-body-to-stream [_ _ output-stream]
;; Use the same buffer as jetty output buffer size
(try
(with-open [bos (buffered-output-stream output-stream buffer-size)]
(let [tw (t/writer bos opts)]
(t/write! tw data)))
(catch Throwable cause
(l/warn :hint "unexpected error on encoding response"
:cause cause))))))
(defn- impl-format-response-body
[response _request]
(let [body (:body response)
opts {:type :json}]
[response {:keys [query-params] :as request}]
(let [body (:body response)
opts {:type (if (contains? query-params "transit_verbose") :json-verbose :json)}]
(cond
(:ws response)
response
(coll? body)
(-> response
(update :headers assoc "content-type" "application/transit+json")
(assoc :body (t/encode body opts)))
(assoc :body (transit-streamable-body body opts)))
(nil? body)
(assoc response :status 204 :body "")
@ -111,11 +137,6 @@
{:name ::errors
:compile (constantly wrap-errors)})
(def metrics
{:name ::metrics
:wrap (fn [handler]
(mtx/wrap-counter handler {:id "http__requests_counter"
:help "Absolute http requests counter."}))})
(def cookies
{:name ::cookies
:compile (constantly wrap-cookies)})
@ -138,24 +159,18 @@
(defn wrap-etag
[handler]
(letfn [(generate-etag [{:keys [body] :as response}]
(str "W/\"" (-> body bh/blake2b-128 bc/bytes->hex) "\""))
(get-match [{:keys [headers] :as request}]
(get headers "if-none-match"))]
(fn [request]
(let [response (handler request)]
(if (= :get (:request-method request))
(let [etag (generate-etag response)
match (get-match request)
response (update response :headers #(assoc % "ETag" etag))]
(cond-> response
(and (string? match)
(= :get (:request-method request))
(= etag match))
(-> response
(assoc :body "")
(assoc :status 304))))
response)))))
(letfn [(encode [data]
(when (string? data)
(str "W/\"" (-> data bh/blake2b-128 bc/bytes->hex) "\"")))]
(fn [{method :request-method headers :headers :as request}]
(cond-> (handler request)
(= :get method)
(as-> $ (if-let [etag (-> $ :body meta :etag encode)]
(cond-> (update $ :headers assoc "etag" etag)
(= etag (get headers "if-none-match"))
(-> (assoc :body "")
(assoc :status 304)))
$))))))
(def etag
{:name ::etag

57
backend/src/app/http/oauth.clj
View File

@ -130,7 +130,7 @@
(when-not (set/subset? provider-roles profile-roles)
(ex/raise :type :internal
:code :unable-to-auth
:hint "not enought permissions"))))
:hint "not enough permissions"))))
(cond-> info
(some? (:invitation-token state))
@ -268,14 +268,29 @@
(defn- discover-oidc-config
[{:keys [base-uri] :as opts}]
(let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
response (http/send! {:method :get :uri (str discovery-uri)})]
(when (= 200 (:status response))
response (ex/try (http/send! {:method :get :uri (str discovery-uri)}))]
(cond
(ex/exception? response)
(do
(l/warn :hint "unable to discover oidc configuration"
:discover-uri (str discovery-uri)
:cause response)
nil)
(= 200 (:status response))
(let [data (json/read-str (:body response))]
(assoc opts
:token-uri (get data "token_endpoint")
:auth-uri (get data "authorization_endpoint")
:user-uri (get data "userinfo_endpoint"))))))
{:token-uri (get data "token_endpoint")
:auth-uri (get data "authorization_endpoint")
:user-uri (get data "userinfo_endpoint")})
:else
(do
(l/warn :hint "unable to discover OIDC configuration"
:uri (str discovery-uri)
:response-status-code (:status response))
nil))))
(defn- obfuscate-string
[s]
@ -299,17 +314,23 @@
(if (and (string? (:base-uri opts))
(string? (:client-id opts))
(string? (:client-secret opts)))
(if (and (string? (:token-uri opts))
(string? (:user-uri opts))
(string? (:auth-uri opts)))
(do
(l/info :action "initialize" :provider "oidc" :method "static"
:opts (pr-str (update opts :client-secret obfuscate-string)))
(assoc-in cfg [:providers "oidc"] opts))
(let [opts (discover-oidc-config opts)]
(l/info :action "initialize" :provider "oidc" :method "discover"
:opts (pr-str (update opts :client-secret obfuscate-string)))
(assoc-in cfg [:providers "oidc"] opts)))
(do
(l/debug :hint "initialize oidc provider" :name "generic-oidc"
:opts (update opts :client-secret obfuscate-string))
(if (and (string? (:token-uri opts))
(string? (:user-uri opts))
(string? (:auth-uri opts)))
(do
(l/debug :hint "initialized with user provided configuration")
(assoc-in cfg [:providers "oidc"] opts))
(do
(l/debug :hint "trying to discover oidc provider configuration using BASE_URI")
(if-let [opts' (discover-oidc-config opts)]
(do
(l/debug :hint "discovered opts" :additional-opts opts')
(assoc-in cfg [:providers "oidc"] (merge opts opts')))
cfg))))
cfg)))
(defn- initialize-google-provider

6
backend/src/app/http/session.clj
View File

@ -58,9 +58,7 @@
(assoc response :cookies {cookie-name {:path "/"
:http-only true
:value id
:same-site (cond (not secure?) :lax
cors? :none
:else :strict)
:same-site (if cors? :none :lax)
:secure secure?}})))
(defn- clear-cookies
@ -74,7 +72,7 @@
(do
(a/>!! (::events-ch cfg) id)
(l/set-context! {:profile-id profile-id})
(handler (assoc request :profile-id profile-id)))
(handler (assoc request :profile-id profile-id :session-id id)))
(handler request))))
;; --- STATE INIT: SESSION

145
backend/src/app/http/websocket.clj Normal file
View File

@ -0,0 +1,145 @@
;; 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) UXBOX Labs SL
(ns app.http.websocket
"A penpot notification service for file cooperative edition."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.db :as db]
[app.metrics :as mtx]
[app.util.websocket :as ws]
[app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[yetti.websocket :as yws]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WEBSOCKET HANDLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare send-presence!)
(defmulti handle-message
(fn [_wsp message] (:type message)))
(defmethod handle-message :connect
[wsp _]
(let [{:keys [msgbus file-id team-id session-id ::ws/output-ch]} @wsp
sub-ch (a/chan (a/dropping-buffer 32))]
(swap! wsp assoc :sub-ch sub-ch)
;; Start a subscription forwarding goroutine
(a/go-loop []
(when-let [val (a/<! sub-ch)]
(when-not (= (:session-id val) session-id)
;; If we receive a connect message of other user, we need
;; to send an update presence to all participants.
(when (= :connect (:type val))
(a/<! (send-presence! @wsp :presence)))
;; Then, just forward the message
(a/>! output-ch val))
(recur)))
(a/go
(a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
(a/<! (send-presence! @wsp :connect)))))
(defmethod handle-message :disconnect
[wsp _]
(a/close! (:sub-ch @wsp))
(send-presence! @wsp :disconnect))
(defmethod handle-message :keepalive
[_ _]
(a/go :nothing))
(defmethod handle-message :pointer-update
[wsp message]
(let [{:keys [profile-id file-id session-id msgbus]} @wsp]
(msgbus :pub {:topic file-id
:message (assoc message
:profile-id profile-id
:session-id session-id)})))
(defmethod handle-message :default
[_ message]
(a/go
(l/log :level :warn
:msg "received unexpected message"
:message message)))
;; --- IMPL
(defn- send-presence!
([ws] (send-presence! ws :presence))
([{:keys [msgbus session-id profile-id file-id]} type]
(msgbus :pub {:topic file-id
:message {:type type
:session-id session-id
:profile-id profile-id}})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP HANDLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare retrieve-file)
(s/def ::msgbus fn?)
(s/def ::file-id ::us/uuid)
(s/def ::session-id ::us/uuid)
(s/def ::handler-params
(s/keys :req-un [::file-id ::session-id]))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::msgbus ::db/pool ::mtx/metrics ::wrk/executor]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics pool] :as cfg}]
(let [metrics {:connections (get-in metrics [:definitions :websocket-active-connections])
:messages (get-in metrics [:definitions :websocket-messages-total])
:sessions (get-in metrics [:definitions :websocket-session-timing])}]
(fn [{:keys [profile-id params] :as req}]
(let [params (us/conform ::handler-params params)
file (retrieve-file pool (:file-id params))
cfg (-> (merge cfg params)
(assoc :profile-id profile-id)
(assoc :team-id (:team-id file))
(assoc ::ws/metrics metrics))]
(when-not profile-id
(ex/raise :type :authentication
:hint "Authentication required."))
(when-not file
(ex/raise :type :not-found
:code :object-not-found))
(when-not (yws/upgrade-request? req)
(ex/raise :type :validation
:code :websocket-request-expected
:hint "this endpoint only accepts websocket connections"))
(->> (ws/handler handle-message cfg)
(yws/upgrade req))))))
(def ^:private
sql:retrieve-file
"select f.id as id,
p.team_id as team_id
from file as f
join project as p on (p.id = f.project_id)
where f.id = ?")
(defn- retrieve-file
[conn id]
(db/exec-one! conn [sql:retrieve-file id]))

6
backend/src/app/loggers/audit.clj
View File

@ -150,7 +150,7 @@
(defmethod ig/init-key ::collector
[_ cfg]
(when (contains? cf/flags :audit-log)
(l/info :msg "intializing audit log collector")
(l/info :msg "initializing audit log collector")
(let [input (a/chan 512 event-xform)
buffer (aa/batch input {:max-batch-size 100
:max-batch-age (* 10 1000) ; 10s
@ -159,7 +159,7 @@
(when-let [[_type events] (a/<! buffer)]
(let [res (a/<! (persist-events cfg events))]
(when (ex/exception? res)
(l/error :hint "error on persiting events"
(l/error :hint "error on persisting events"
:cause res)))
(recur)))
@ -195,7 +195,7 @@
;; Archive Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is a task responsible to send the accomulated events to an
;; This is a task responsible to send the accumulated events to an
;; external service for archival.
(declare archive-events)

5
backend/src/app/loggers/database.clj
View File

@ -7,9 +7,7 @@
(ns app.loggers.database
"A specific logger impl that persists errors on the database."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -52,7 +50,8 @@
(assoc :tenant (cf/get :tenant))
(assoc :host (cf/get :host))
(assoc :public-uri (cf/get :public-uri))
(assoc :version (:full cf/version))))
(assoc :version (:full cf/version))
(update :id (fn [id] (or id (uuid/next))))))
(defn handle-event
[{:keys [executor] :as cfg} event]

2
backend/src/app/loggers/loki.clj
View File

@ -30,7 +30,7 @@
(defmethod ig/init-key ::reporter
[_ {:keys [receiver uri] :as cfg}]
(when uri
(l/info :msg "intializing loki reporter" :uri uri)
(l/info :msg "initializing loki reporter" :uri uri)
(let [input (a/chan (a/dropping-buffer 512))]
(receiver :sub input)
(a/go-loop []

2
backend/src/app/loggers/zmq.clj
View File

@ -31,7 +31,7 @@
(defmethod ig/init-key ::receiver
[_ {:keys [endpoint] :as cfg}]
(l/info :msg "intializing ZMQ receiver" :bind endpoint)
(l/info :msg "initializing ZMQ receiver" :bind endpoint)
(let [buffer (a/chan 1)
output (a/chan 1 (comp (filter map?)
(keep prepare)))

81
backend/src/app/main.clj
View File

@ -9,7 +9,8 @@
[app.common.logging :as l]
[app.config :as cf]
[app.util.time :as dt]
[integrant.core :as ig]))
[integrant.core :as ig])
(:gen-class))
(def system-config
{:app.db/pool
@ -22,33 +23,15 @@
:min-pool-size 0
:max-pool-size 30}
:app.migrations/migrations
{}
:app.metrics/metrics
{:definitions
{:profile-register
{:name "actions_profile_register_count"
:help "A global counter of user registrations."
:type :counter}
:profile-activation
{:name "actions_profile_activation_count"
:help "A global counter of profile activations"
:type :counter}
:update-file-changes
{:name "rpc_update_file_changes_total"
:help "A total number of changes submitted to update-file."
:type :counter}
:update-file-bytes-processed
{:name "rpc_update_file_bytes_processed_total"
:help "A total number of bytes processed by update-file."
:type :counter}}}
{}
:app.migrations/all
{:main (ig/ref :app.migrations/migrations)}
:app.migrations/migrations
{}
:app.msgbus/msgbus
{:backend (cf/get :msgbus-backend :redis)
@ -91,27 +74,34 @@
:app.http/server
{:port (cf/get :http-server-port)
:host (cf/get :http-server-host)
:router (ig/ref :app.http/router)
:metrics (ig/ref :app.metrics/metrics)
:ws {"/ws/notifications" (ig/ref :app.notifications/handler)}}
:metrics (ig/ref :app.metrics/metrics)}
:app.http/router
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:public-uri (cf/get :public-uri)
:metrics (ig/ref :app.metrics/metrics)
:oauth (ig/ref :app.http.oauth/handler)
:assets (ig/ref :app.http.assets/handlers)
:storage (ig/ref :app.storage/storage)
:sns-webhook (ig/ref :app.http.awsns/handler)
:feedback (ig/ref :app.http.feedback/handler)
{:assets (ig/ref :app.http.assets/handlers)
:feedback (ig/ref :app.http.feedback/handler)
:session (ig/ref :app.http.session/session)
:sns-webhook (ig/ref :app.http.awsns/handler)
:oauth (ig/ref :app.http.oauth/handler)
:debug (ig/ref :app.http.debug/handlers)
:audit-http-handler (ig/ref :app.loggers.audit/http-handler)}
:ws (ig/ref :app.http.websocket/handler)
:metrics (ig/ref :app.metrics/metrics)
:public-uri (cf/get :public-uri)
:storage (ig/ref :app.storage/storage)
:tokens (ig/ref :app.tokens/tokens)
:audit-http-handler (ig/ref :app.loggers.audit/http-handler)
:rpc (ig/ref :app.rpc/rpc)}
:app.http.debug/handlers
{:pool (ig/ref :app.db/pool)}
:app.http.websocket/handler
{:pool (ig/ref :app.db/pool)
:executor (ig/ref :app.worker/executor)
:metrics (ig/ref :app.metrics/metrics)
:msgbus (ig/ref :app.msgbus/msgbus)}
:app.http.assets/handlers
{:metrics (ig/ref :app.metrics/metrics)
:assets-path (cf/get :assets-path)
@ -123,12 +113,12 @@
{:pool (ig/ref :app.db/pool)}
:app.http.oauth/handler
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:pool (ig/ref :app.db/pool)
:tokens (ig/ref :app.tokens/tokens)
:audit (ig/ref :app.loggers.audit/collector)
:public-uri (cf/get :public-uri)}
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:pool (ig/ref :app.db/pool)
:tokens (ig/ref :app.tokens/tokens)
:audit (ig/ref :app.loggers.audit/collector)
:public-uri (cf/get :public-uri)}
:app.rpc/rpc
{:pool (ig/ref :app.db/pool)
@ -140,13 +130,6 @@
:public-uri (cf/get :public-uri)
:audit (ig/ref :app.loggers.audit/collector)}
:app.notifications/handler
{:msgbus (ig/ref :app.msgbus/msgbus)
:pool (ig/ref :app.db/pool)
:session (ig/ref :app.http.session/session)
:metrics (ig/ref :app.metrics/metrics)
:executor (ig/ref :app.worker/executor)}
:app.worker/executor
{:min-threads 0
:max-threads 256

6
backend/src/app/media.clj
View File

@ -202,11 +202,9 @@
:cause error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Fonts Generation
;; Fonts Generation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def all-fotmats #{"font/woff2", "font/woff", "font/otf", "font/ttf"})
(defmethod process :generate-fonts
[{:keys [input] :as params}]
(letfn [(ttf->otf [data]
@ -326,7 +324,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn configure-assets-storage
"Given storage map, returns a storage configured with the apropriate
"Given storage map, returns a storage configured with the appropriate
backend for assets."
[storage conn]
(-> storage

70
backend/src/app/metrics.clj
View File

@ -26,27 +26,57 @@
(declare instrument)
(declare create-registry)
(declare create)
(declare handler)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Defaults
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def default-metrics
{:profile-register
{:name "actions_profile_register_count"
:help "A global counter of user registrations."
:type :counter}
:profile-activation
{:name "actions_profile_activation_count"
:help "A global counter of profile activations"
:type :counter}
:update-file-changes
{:name "rpc_update_file_changes_total"
:help "A total number of changes submitted to update-file."
:type :counter}
:update-file-bytes-processed
{:name "rpc_update_file_bytes_processed_total"
:help "A total number of bytes processed by update-file."
:type :counter}
:websocket-active-connections
{:name "websocket_active_connections"
:help "Active websocket connections gauge"
:type :gauge}
:websocket-messages-total
{:name "websocket_message_total"
:help "Counter of processed messages."
:labels ["op"]
:type :counter}
:websocket-session-timing
{:name "websocket_session_timing"
:help "Websocket session timing (seconds)."
:quantiles []
:type :summary}})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- handler
[registry _request]
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
writer (StringWriter.)]
(TextFormat/write004 writer samples)
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))
(s/def ::definitions
(s/map-of keyword? map?))
(defmethod ig/pre-init-spec ::metrics [_]
(s/keys :opt-un [::definitions]))
(defmethod ig/init-key ::metrics
[_ {:keys [definitions] :as cfg}]
[_ _]
(l/info :action "initialize metrics")
(let [registry (create-registry)
definitions (reduce-kv (fn [res k v]
@ -54,7 +84,7 @@
(create)
(assoc res k)))
{}
definitions)]
default-metrics)]
{:handler (partial handler registry)
:definitions definitions
:registry registry}))
@ -64,6 +94,14 @@
(s/def ::metrics
(s/keys :req-un [::registry ::handler]))
(defn- handler
[registry _request]
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
writer (StringWriter.)]
(TextFormat/write004 writer samples)
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

3
backend/src/app/migrations.clj
View File

@ -202,6 +202,9 @@
{:name "0064-mod-audit-log-table"
:fn (mg/resource "app/migrations/sql/0064-mod-audit-log-table.sql")}
{:name "0065-add-trivial-spelling-fixes"
:fn (mg/resource "app/migrations/sql/0065-add-trivial-spelling-fixes.sql")}
])

2
backend/src/app/migrations/sql/0035-add-storage-tables.sql
View File

@ -22,7 +22,7 @@ CREATE TABLE storage_data (
CREATE INDEX storage_data__id__idx ON storage_data(id);
-- Table used for store inflight upload ids, for later recheck and
-- delete possible staled files that exists on the phisical storage
-- delete possible staled files that exists on the physical storage
-- but does not exists in the 'storage_object' table.
CREATE TABLE storage_pending (

2
backend/src/app/migrations/sql/0062-fix-metadata-media.sql
View File

@ -1,4 +1,4 @@
-- Fix problem with content-type inconherence
-- Fix problem with content-type incoherence
UPDATE storage_object so
SET metadata = jsonb_set(metadata, '{~:content-type}', to_jsonb(fmo.mtype))

2
backend/src/app/migrations/sql/0065-add-trivial-spelling-fixes.sql Normal file
View File

@ -0,0 +1,2 @@
ALTER INDEX file__modified_at__has_media_trimed__idx RENAME TO file__modified_at__has_media_trimmed__idx;
ALTER INDEX media_bject__file_id__idx RENAME TO media_object__file_id__idx;

2
backend/src/app/migrations/sql/XXXX-drop-obsolete-tables.sql
View File

@ -1,5 +1,5 @@
--- This is a second migration but it should be applied when manual
--- migration intervention is alteady executed.
--- migration intervention is already executed.
ALTER TABLE file_media_object ALTER COLUMN media_id SET NOT NULL;
DROP TABLE file_media_thumbnail;

2
backend/src/app/msgbus.clj
View File

@ -243,7 +243,7 @@
(recur))
(a/close! rcv-ch)))
;; Asyncrhonous message processing loop;x
;; Asynchronous message processing loop;x
(a/go-loop []
(if-let [{:keys [topic message]} (a/<! rcv-ch)]
;; This means we receive data from redis and we need to

281
backend/src/app/notifications.clj
View File

@ -1,281 +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) UXBOX Labs SL
(ns app.notifications
"A websocket based notifications mechanism."
(:require
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.transit :as t]
[app.db :as db]
[app.metrics :as mtx]
[app.util.async :as aa]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[ring.adapter.jetty9 :as jetty]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.params :refer [wrap-params]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Http Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare retrieve-file)
(declare websocket)
(declare handler)
(s/def ::session map?)
(s/def ::msgbus fn?)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::msgbus ::db/pool ::session ::mtx/metrics ::wrk/executor]))
(defmethod ig/init-key ::handler
[_ {:keys [session metrics] :as cfg}]
(let [wrap-session (:middleware session)
mtx-active-connections
(mtx/create
{:name "websocket_active_connections"
:registry (:registry metrics)
:type :gauge
:help "Active websocket connections."})
mtx-messages
(mtx/create
{:name "websocket_message_total"
:registry (:registry metrics)
:labels ["op"]
:type :counter
:help "Counter of processed messages."})
mtx-sessions
(mtx/create
{:name "websocket_session_timing"
:registry (:registry metrics)
:quantiles []
:help "Websocket session timing (seconds)."
:type :summary})
cfg (assoc cfg
:mtx-active-connections mtx-active-connections
:mtx-messages mtx-messages
:mtx-sessions mtx-sessions
)]
(-> #(handler cfg %)
(wrap-session)
(wrap-keyword-params)
(wrap-cookies)
(wrap-params))))
(s/def ::file-id ::us/uuid)
(s/def ::session-id ::us/uuid)
(s/def ::websocket-handler-params
(s/keys :req-un [::file-id ::session-id]))
(defn- handler
[{:keys [pool] :as cfg} {:keys [profile-id params] :as req}]
(let [params (us/conform ::websocket-handler-params params)
file (retrieve-file pool (:file-id params))
cfg (merge cfg params
{:profile-id profile-id
:team-id (:team-id file)})]
(cond
(not profile-id)
{:error {:code 403 :message "Authentication required"}}
(not file)
{:error {:code 404 :message "File does not exists"}}
:else
(websocket cfg))))
(def ^:private
sql:retrieve-file
"select f.id as id,
p.team_id as team_id
from file as f
join project as p on (p.id = f.project_id)
where f.id = ?")
(defn- retrieve-file
[conn id]
(db/exec-one! conn [sql:retrieve-file id]))
;; --- WEBSOCKET INIT
(declare handle-connect)
(defn- ws-send
[conn data]
(try
(when (jetty/connected? conn)
(jetty/send! conn data)
true)
(catch java.lang.NullPointerException _e
false)))
(defn websocket
[{:keys [file-id team-id msgbus executor] :as cfg}]
(let [rcv-ch (a/chan 32)
out-ch (a/chan 32)
mtx-aconn (:mtx-active-connections cfg)
mtx-messages (:mtx-messages cfg)
mtx-sessions (:mtx-sessions cfg)
created-at (dt/now)
ws-send (mtx/wrap-counter ws-send mtx-messages ["send"])]
(letfn [(on-connect [conn]
((::mtx/fn mtx-aconn) {:cmd :inc :by 1})
;; A subscription channel should use a lossy buffer
;; because we can't penalize normal clients when one
;; slow client is connected to the room.
(let [sub-ch (a/chan (a/dropping-buffer 128))
cfg (assoc cfg
:conn conn
:rcv-ch rcv-ch
:out-ch out-ch
:sub-ch sub-ch)]
(l/trace :event "connect" :session (:session-id cfg))
;; Forward all messages from out-ch to the websocket
;; connection
(a/go-loop []
(let [val (a/<! out-ch)]
(when (some? val)
(when (a/<! (aa/thread-call executor #(ws-send conn (t/encode-str val))))
(recur)))))
(a/go
;; Subscribe to corresponding topics
(a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
(a/<! (handle-connect cfg))
;; when connection is closed
((::mtx/fn mtx-aconn) {:cmd :dec :by 1})
((::mtx/fn mtx-sessions) {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
;; close subscription
(a/close! sub-ch))))
(on-error [_conn _e]
(l/trace :event "error" :session (:session-id cfg))
(a/close! out-ch)
(a/close! rcv-ch))
(on-close [_conn _status _reason]
(l/trace :event "close" :session (:session-id cfg))
(a/close! out-ch)
(a/close! rcv-ch))
(on-message [_ws message]
(let [message (t/decode-str message)]
(when-not (a/offer! rcv-ch message)
(l/warn :msg "drop messages"))))]
{:on-connect on-connect
:on-error on-error
:on-close on-close
:on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
:on-bytes (constantly nil)})))
;; --- CONNECTION INIT
(declare send-presence)
(declare handle-message)
(declare start-loop!)
(defn- handle-connect
[cfg]
(a/go
(a/<! (handle-message cfg {:type :connect}))
(a/<! (start-loop! cfg))
(a/<! (handle-message cfg {:type :disconnect}))))
(defn- start-loop!
[{:keys [rcv-ch out-ch sub-ch session-id] :as cfg}]
(a/go-loop []
(let [timeout (a/timeout 30000)
[val port] (a/alts! [rcv-ch sub-ch timeout])]
(cond
;; Process message coming from connected client
(and (= port rcv-ch) (some? val))
(do
(a/<! (handle-message cfg val))
(recur))
;; Process message coming from pubsub.
(and (= port sub-ch) (some? val))
(do
(when-not (= (:session-id val) session-id)
;; If we receive a connect message of other user, we need
;; to send an update presence to all participants.
(when (= :connect (:type val))
(a/<! (send-presence cfg :presence)))
;; Then, just forward the message
(a/>! out-ch val))
(recur))
;; When timeout channel is signaled, we need to send a ping
;; message to the output channel. TODO: we need to make this
;; more smart.
(= port timeout)
(do
(a/>! out-ch {:type :ping})
(recur))))))
(defn send-presence
([cfg] (send-presence cfg :presence))
([{:keys [msgbus session-id profile-id file-id]} type]
(a/go
(a/<! (msgbus :pub {:topic file-id
:message {:type type
:session-id session-id
:profile-id profile-id}})))))
;; --- INCOMING MSG PROCESSING
(defmulti handle-message
(fn [_ message] (:type message)))
(defmethod handle-message :connect
[cfg _]
(send-presence cfg :connect))
(defmethod handle-message :disconnect
[cfg _]
(send-presence cfg :disconnect))
(defmethod handle-message :keepalive
[_ _]
(a/go :nothing))
(defmethod handle-message :pointer-update
[{:keys [profile-id file-id session-id msgbus] :as cfg} message]
(let [message (assoc message
:profile-id profile-id
:session-id session-id)]
(msgbus :pub {:topic file-id
:message message})))
(defmethod handle-message :default
[_ws message]
(a/go
(l/log :level :warn
:msg "received unexpected message"
:message message)))

8
backend/src/app/rpc.clj
View File

@ -29,7 +29,7 @@
response)
(defn- rpc-query-handler
[methods {:keys [profile-id] :as request}]
[methods {:keys [profile-id session-id] :as request}]
(let [type (keyword (get-in request [:path-params :type]))
data (merge (:params request)
@ -38,7 +38,7 @@
{::request request})
data (if profile-id
(assoc data :profile-id profile-id)
(assoc data :profile-id profile-id ::session-id session-id)
(dissoc data :profile-id))
result ((get methods type default-handler) data)
@ -49,7 +49,7 @@
((:transform-response mdata) request))))
(defn- rpc-mutation-handler
[methods {:keys [profile-id] :as request}]
[methods {:keys [profile-id session-id] :as request}]
(let [type (keyword (get-in request [:path-params :type]))
data (merge (:params request)
(:body-params request)
@ -57,7 +57,7 @@
{::request request})
data (if profile-id
(assoc data :profile-id profile-id)
(assoc data :profile-id profile-id ::session-id session-id)
(dissoc data :profile-id))
result ((get methods type default-handler) data)

2
backend/src/app/rpc/mutations/comments.clj
View File

@ -174,7 +174,7 @@
:content content})]
;; NOTE: this is done in SQL instead of using db/update!
;; helper bacause currently the helper does not allow pass raw
;; helper because currently the helper does not allow pass raw
;; function call parameters to the underlying prepared
;; statement; in a future when we fix/improve it, this can be
;; changed to use the helper.

49
backend/src/app/rpc/mutations/files.clj
View File

@ -182,7 +182,7 @@
:library-file-id library-id}))
;; --- Mutation: Update syncrhonization status of a link
;; --- Mutation: Update synchronization status of a link
(declare update-sync)
@ -414,8 +414,9 @@
[conn project-id]
(:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
;; TEMPORARY FILE CREATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TEMPORARY FILES (behaves differently)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::create-temp-file ::create-file)
@ -425,6 +426,23 @@
(proj/check-edition-permissions! conn profile-id project-id)
(create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
(s/def ::update-temp-file
(s/keys :req-un [::changes ::revn ::session-id ::id]))
(sv/defmethod ::update-temp-file
[{:keys [pool] :as cfg} {:keys [profile-id session-id id revn changes] :as params}]
(db/with-atomic [conn pool]
(db/insert! conn :file-change
{:id (uuid/next)
:session-id session-id
:profile-id profile-id
:created-at (dt/now)
:file-id id
:revn revn
:data nil
:changes (blob/encode changes)})
nil))
(s/def ::persist-temp-file
(s/keys :req-un [::id ::profile-id]))
@ -432,6 +450,25 @@
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(db/update! conn :file
{:deleted-at nil}
{:id id})))
(let [file (db/get-by-id conn :file id)
revs (db/query conn :file-change
{:file-id id}
{:order-by [[:revn :asc]]})
revn (count revs)]
(when (nil? (:deleted-at file))
(ex/raise :type :validation
:code :cant-persist-already-persisted-file))
(loop [revs (seq revs)
data (blob/decode (:data file))]
(if-let [rev (first revs)]
(recur (rest revs)
(->> rev :changes blob/decode (cp/process-changes data)))
(db/update! conn :file
{:deleted-at nil
:revn revn
:data (blob/encode data)}
{:id id})))
nil)))

6
backend/src/app/rpc/mutations/management.clj
View File

@ -62,7 +62,7 @@
(= :image (:type form)))
(update-in [:metadata :id] #(get index % %))))
;; A function responsible to analize all file data and
;; A function responsible to analyze all file data and
;; replace the old :component-file reference with the new
;; ones, using the provided file-index
(relink-shapes [data]
@ -294,7 +294,7 @@
;; move all files to the project
(db/exec-one! conn [sql:move-files project-id fids])
;; delete posible broken relations on moved files
;; delete possible broken relations on moved files
(db/exec-one! conn [sql:delete-broken-relations pids])
nil)))
@ -329,7 +329,7 @@
{:team-id team-id}
{:id project-id})
;; delete posible broken relations on moved files
;; delete possible broken relations on moved files
(db/exec-one! conn [sql:delete-broken-relations pids])
nil)))

24
backend/src/app/rpc/mutations/profile.clj
View File

@ -108,7 +108,7 @@
:code :email-domain-is-not-allowed)))
;; Don't allow proceed in preparing registration if the profile is
;; already reported as spamer.
;; already reported as spammer.
(when (eml/has-bounce-reports? pool (:email params))
(ex/raise :type :validation
:code :email-has-permanent-bounces
@ -177,7 +177,7 @@
::audit/profile-id (:id profile)}))
;; If auth backend is different from "penpot" means user is
;; registring using third party auth mechanism; in this case
;; registering using third party auth mechanism; in this case
;; we need to mark this session as logged.
(not= "penpot" (:auth-backend profile))
(with-meta (profile/strip-private-attrs profile)
@ -370,6 +370,7 @@
(declare validate-password!)
(declare update-profile-password!)
(declare invalidate-profile-session!)
(s/def ::update-profile-password
(s/keys :req-un [::profile-id ::password ::old-password]))
@ -378,10 +379,18 @@
{::rlimit/permits (cf/get :rlimit-password)}
[{:keys [pool] :as cfg} {:keys [password] :as params}]
(db/with-atomic [conn pool]
(let [profile (validate-password! conn params)]
(let [profile (validate-password! conn params)
session-id (:app.rpc/session-id params)]
(update-profile-password! conn (assoc profile :password password))
(invalidate-profile-session! conn (:id profile) session-id)
nil)))
(defn- invalidate-profile-session!
"Removes all sessions except the current one."
[conn profile-id session-id]
(let [sql "delete from http_session where profile_id = ? and id != ?"]
(:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
(defn- validate-password!
[conn {:keys [profile-id old-password] :as params}]
(let [profile (db/get-by-id conn :profile profile-id)]
@ -396,7 +405,6 @@
{:password (derive-password password)}
{:id id}))
;; --- MUTATION: Update Photo
(declare update-profile-photo)
@ -438,7 +446,7 @@
;; --- MUTATION: Request Email Change
(declare request-email-change)
(declare change-email-inmediatelly)
(declare change-email-immediately)
(s/def ::request-email-change
(s/keys :req-un [::email]))
@ -454,9 +462,9 @@
(if (or (cf/get :smtp-enabled)
(contains? cf/flags :smtp))
(request-email-change cfg params)
(change-email-inmediatelly cfg params)))))
(change-email-immediately cfg params)))))
(defn- change-email-inmediatelly
(defn- change-email-immediately
[{:keys [conn]} {:keys [profile email] :as params}]
(when (not= email (:email profile))
(check-profile-existence! conn params))
@ -639,7 +647,7 @@
(let [rows (db/exec! conn [sql:owned-teams profile-id])]
;; If we found owned teams with more than one profile we don't
;; allow delete profile until the user properly transfer ownership
;; or explictly removes all participants from the team.
;; or explicitly removes all participants from the team.
(when (some #(> (:num-profiles %) 1) rows)
(ex/raise :type :validation
:code :owner-teams-with-people

6
backend/src/app/rpc/mutations/teams.clj
View File

@ -164,7 +164,7 @@
(s/keys :req-un [::profile-id ::id]))
;; TODO: right now just don't allow delete default team, in future it
;; should raise a speific exception for signal that this acction is
;; should raise a specific exception for signal that this action is
;; not allowed.
(sv/defmethod ::delete-team
@ -201,8 +201,8 @@
(let [perms (teams/get-permissions conn profile-id team-id)
;; We retrieve all team members instead of query the
;; database for a single member. This is just for
;; convenience, if this bocomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanims.
;; convenience, if this becomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanisms.
members (teams/retrieve-team-members conn team-id)
member (d/seek #(= member-id (:id %)) members)

4
backend/src/app/rpc/mutations/verify_token.clj
View File

@ -134,7 +134,7 @@
;; If the session does not matches the invited member, replace
;; the session with a new one matching the invited member.
;; This techinique should be considered secure because the
;; This technique should be considered secure because the
;; user clicking the link he already has access to the email
;; account.
(with-meta
@ -179,7 +179,7 @@
::audit/profile-id member-id}))
;; In this case, we wait until frontend app redirect user to
;; registeration page, the user is correctly registered and the
;; registration page, the user is correctly registered and the
;; register mutation call us again with the same token to finally
;; create the corresponding team-profile relation from the first
;; condition of this if.

85
backend/src/app/rpc/queries/files.clj
View File

@ -6,6 +6,8 @@
(ns app.rpc.queries.files
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
@ -84,8 +86,8 @@
(let [perms (get-permissions conn profile-id file-id)
ldata (retrieve-share-link conn file-id share-id)]
;; NOTE: in a future when share-link becomes more powerfull and
;; will allow us specify which parts of the app is availabel, we
;; NOTE: in a future when share-link becomes more powerful and
;; will allow us specify which parts of the app is available, we
;; will probably need to tweak this function in order to expose
;; this flags to the frontend.
(cond
@ -165,6 +167,7 @@
f.created_at,
f.modified_at,
f.name,
f.revn,
f.is_shared
from file as f
where f.project_id = ?
@ -214,11 +217,66 @@
(some-> (retrieve-file cfg id)
(assoc :permissions perms)))))
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]))
(declare trim-file-data)
(defn remove-thumbnails-frames
"Removes from data the children for frames that have a thumbnail set up"
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::trimmed-file
(s/keys :req-un [::profile-id ::id ::object-id ::page-id]))
(sv/defmethod ::trimmed-file
"Retrieve a file by its ID and trims all unnecesary content from
it. It is mainly used for rendering a concrete object, so we don't
need force download all shapes when only a small subset is
necesseary."
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg :conn conn)
perms (get-permissions conn profile-id id)]
(check-read-permissions! perms)
(some-> (retrieve-file cfg id)
(trim-file-data params)
(assoc :permissions perms)))))
(defn- trim-file-data
[file {:keys [page-id object-id]}]
(let [page (get-in file [:data :pages-index page-id])
objects (->> (:objects page)
(cp/get-object-with-children object-id)
(map #(dissoc % :thumbnail)))
objects (d/index-by :id objects)
page (assoc page :objects objects)]
(-> file
(update :data assoc :pages-index {page-id page})
(update :data assoc :pages [page-id]))))
(declare strip-frames-with-thumbnails)
(s/def ::strip-frames-with-thumbnails ::us/boolean)
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::strip-frames-with-thumbnails]))
(sv/defmethod ::page
"Retrieves the first page of the file. Used mainly for render
thumbnails on dashboard."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(db/with-atomic [conn pool]
(check-read-permissions! conn profile-id file-id)
(let [cfg (assoc cfg :conn conn)
file (retrieve-file cfg file-id)
page-id (get-in file [:data :pages 0])]
(cond-> (get-in file [:data :pages-index page-id])
(true? (:strip-frames-with-thumbnails props))
(strip-frames-with-thumbnails)))))
(defn strip-frames-with-thumbnails
"Remove unnecesary shapes from frames that have thumbnail."
[data]
(let [filter-shape?
(fn [objects [id shape]]
@ -227,7 +285,7 @@
(= frame-id uuid/zero)
(not (some? (get-in objects [frame-id :thumbnail]))))))
;; We need to remove from the attribute :shapes its childrens because
;; We need to remove from the attribute :shapes its children because
;; they will not be sent in the data
remove-frame-children
(fn [[id shape]]
@ -244,22 +302,12 @@
(update data :objects update-objects)))
(sv/defmethod ::page
[{:keys [pool] :as cfg} {:keys [profile-id file-id strip-thumbnails]}]
(db/with-atomic [conn pool]
(check-read-permissions! conn profile-id file-id)
(let [cfg (assoc cfg :conn conn)
file (retrieve-file cfg file-id)
page-id (get-in file [:data :pages 0])]
(cond-> (get-in file [:data :pages-index page-id])
strip-thumbnails
(remove-thumbnails-frames)))))
;; --- Query: Shared Library Files
(def ^:private sql:team-shared-files
"select f.id,
f.revn,
f.project_id,
f.created_at,
f.modified_at,
@ -330,6 +378,7 @@
(def sql:team-recent-files
"with recent_files as (
select f.id,
f.revn,
f.project_id,
f.created_at,
f.modified_at,

3
backend/src/app/rpc/queries/profile.clj
View File

@ -37,7 +37,6 @@
(sv/defmethod ::profile {:auth false}
[{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
;; We need to return the anonymous profile object in two cases, when
;; no profile-id is in session, and when db call raises not found. In all other
;; cases we need to reraise the exception.
@ -111,6 +110,6 @@
;; --- Attrs Helpers
(defn strip-private-attrs
"Only selects a publicy visible profile attrs."
"Only selects a publicly visible profile attrs."
[row]
(dissoc row :password :deleted-at))

2
backend/src/app/rpc/queries/viewer.clj
View File

@ -65,7 +65,7 @@
(ex/raise :type :not-found
:code :object-not-found))
;; When we have only profile, we need to check read permissiones
;; When we have only profile, we need to check read permissions
;; on file.
(when (and profile-id (not slink))
(files/check-read-permissions! conn profile-id file-id))

129
backend/src/app/srepl/main.clj
View File

@ -3,8 +3,11 @@
#_:clj-kondo/ignore
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.pages.migrations :as pmg]
[app.common.pages.spec :as spec]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
@ -13,8 +16,11 @@
[app.rpc.queries.profile :as prof]
[app.srepl.dev :as dev]
[app.util.blob :as blob]
[app.util.time :as dt]
[clojure.pprint :refer [pprint]]
[cuerdas.core :as str]))
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[expound.alpha :as expound]))
(defn update-file
([system id f] (update-file system id f false))
@ -33,8 +39,8 @@
{:id (:id file)}))
(update file :data blob/decode)))))
(defn update-file-raw
[id data]
(defn reset-file-data
[system id data]
(db/with-atomic [conn (:app.db/pool system)]
(db/update! conn :file
{:data data}
@ -42,36 +48,13 @@
(defn get-file
[system id]
(with-open [conn (db/open (:app.db/pool system))]
(let [file (db/get-by-id conn :file id)]
(-> file
(update :data app.util.blob/decode)
(update :data pmg/migrate-data)))))
;; Examples:
;; (def backup (update-file #uuid "1586e1f0-3e02-11eb-b1d2-556a2f641513" identity))
;; (def x (update-file
;; #uuid "1586e1f0-3e02-11eb-b1d2-556a2f641513"
;; (fn [{:keys [data] :as file}]
;; (update-in data [:pages-index #uuid "878278c0-3ef0-11eb-9d67-8551e7624f43" :objects] dissoc nil))))
;; Migrate
(defn update-file-data-blob-format
[system]
(db/with-atomic [conn (:app.db/pool system)]
(doseq [id (->> (db/exec! conn ["select id from file;"]) (map :id))]
(let [{:keys [data]} (db/get-by-id conn :file id {:columns [:id :data]})]
(prn "Updating file:" id)
(db/update! conn :file
{:data (-> (blob/decode data)
(blob/encode {:version 2}))}
{:id id})))))
(-> (:app.db/pool system)
(db/get-by-id :file id)
(update :data app.util.blob/decode)
(update :data pmg/migrate-data)))
(defn duplicate-file
"This is a raw version of duplication of file just only for forensic analisys"
"This is a raw version of duplication of file just only for forensic analysis"
[system file-id email]
(db/with-atomic [conn (:app.db/pool system)]
(when-let [profile (some->> (prof/retrieve-profile-data-by-email conn (str/lower email))
@ -82,3 +65,87 @@
:project-id (:default-project-id profile))]
(db/insert! conn :file params)
(:id file))))))
(defn verify-files
[system {:keys [age sleep chunk-size max-chunks stop-on-error? verbose?]
:or {sleep 1000
age "72h"
chunk-size 10
verbose? false
stop-on-error? true
max-chunks ##Inf}}]
(letfn [(retrieve-chunk [conn cursor]
(let [sql (str "select id, name, modified_at, data from file "
" where modified_at > ? and deleted_at is null "
" order by modified_at asc limit ?")
age (if cursor
cursor
(-> (dt/now) (dt/minus age)))]
(seq (db/exec! conn [sql age chunk-size]))))
(validate-item [{:keys [id data modified-at] :as file}]
(let [data (blob/decode data)
valid? (s/valid? ::spec/data data)]
(l/debug :hint "validated file"
:file-id id
:age (-> (dt/diff modified-at (dt/now))
(dt/truncate :minutes)
(str)
(subs 2)
(str/lower))
:valid valid?)
(when (and (not valid?) verbose?)
(let [edata (-> (s/explain-data ::spec/data data)
(update ::s/problems #(take 5 %)))]
(binding [s/*explain-out* expound/printer]
(l/warn ::l/raw (with-out-str (s/explain-out edata))))))
(when (and (not valid?) stop-on-error?)
(throw (ex-info "penpot/abort" {})))
valid?))
(validate-chunk [chunk]
(loop [items chunk
success 0
errored 0]
(if-let [item (first items)]
(if (validate-item item)
(recur (rest items) (inc success) errored)
(recur (rest items) success (inc errored)))
[(:modified-at (last chunk))
success
errored])))
(fmt-result [ns ne]
{:total (+ ns ne)
:errors ne
:success ns})
]
(try
(db/with-atomic [conn (:app.db/pool system)]
(loop [cursor nil
chunks 0
success 0
errors 0]
(if (< chunks max-chunks)
(if-let [chunk (retrieve-chunk conn cursor)]
(let [[cursor success' errors'] (validate-chunk chunk)]
(Thread/sleep (inst-ms (dt/duration sleep)))
(recur cursor
(inc chunks)
(+ success success')
(+ errors errors')))
(fmt-result success errors))
(fmt-result success errors))))
(catch Throwable cause
(when (not= "penpot/abort" (ex-message cause))
(throw cause))
:error))))

12
backend/src/app/storage.clj
View File

@ -188,7 +188,7 @@
object))
(defn clone-object
"Creates a clone of the provided object using backend basded efficient
"Creates a clone of the provided object using backend based efficient
method. Always clones objects to the configured default."
[{:keys [pool conn] :as storage} object]
(us/assert ::storage storage)
@ -323,18 +323,18 @@
returning *;")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Garbage Collection: Analize touched objects
;; Garbage Collection: Analyze touched objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This task is part of the garbage collection of storage objects and
;; is responsible on analizing the touched objects and mark them for deletion
;; is responsible on analyzing the touched objects and mark them for deletion
;; if corresponds.
;;
;; When file_media_object is deleted, the depending storage_object are
;; marked as touched. This means that some files that depend on a
;; concrete storage_object are no longer exists and maybe this
;; storage_object is no longer necessary and can be ellegible for
;; elimination. This task peridically analizes touched objects and
;; storage_object is no longer necessary and can be eligible for
;; elimination. This task periodically analyzes touched objects and
;; mark them as freeze (means that has other references and the object
;; is still valid) or deleted (no more references to this object so is
;; ready to be deleted).
@ -408,7 +408,7 @@
;; For this situations we need to write a "log" of inserted files that
;; are checked in some time in future. If physical file exists but the
;; database refence does not exists means that leaked file is found
;; and is inmediatelly deleted. The responsability of this task is
;; and is immediately deleted. The responsibility of this task is
;; check that write log for possible leaked files.
(def recheck-min-age (dt/duration {:hours 1}))

4
backend/src/app/tasks/file_media_gc.clj
View File

@ -6,7 +6,7 @@
(ns app.tasks.file-media-gc
"A maintenance task that is responsible to purge the unused media
objects from files. A file is ellegible to be garbage collected
objects from files. A file is eligible to be garbage collected
after some period of inactivity (the default threshold is 72h)."
(:require
[app.common.logging :as l]
@ -107,7 +107,7 @@
:thumbnail-id (:thumbnail-id mobj))
;; NOTE: deleting the file-media-object in the database
;; automatically marks as toched the referenced storage
;; automatically marks as touched the referenced storage
;; objects. The touch mechanism is needed because many files can
;; point to the same storage objects and we can't just delete
;; them.

2
backend/src/app/tasks/objects_gc.clj
View File

@ -129,7 +129,7 @@
(doseq [{:keys [id] :as profile} profiles]
(l/trace :action "delete object" :table table :id id)
;; Mark the owned teams as deleted; this enables them to be procesed
;; Mark the owned teams as deleted; this enables them to be processed
;; in the same transaction in the "team" table step.
(db/exec-one! conn [sql:mark-owned-teams-deleted id max-age])

79
backend/src/app/tasks/telemetry.clj
View File

@ -5,7 +5,7 @@
;; Copyright (c) UXBOX Labs SL
(ns app.tasks.telemetry
"A task that is reponsible to collect anonymous statistical
"A task that is responsible to collect anonymous statistical
information about the current instance and send it to the telemetry
server."
(:require
@ -19,10 +19,8 @@
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(declare handler)
(declare acquire-lock)
(declare release-all-locks)
(declare retrieve-stats)
(declare send!)
(s/def ::version ::us/string)
(s/def ::uri ::us/string)
@ -34,49 +32,48 @@
(s/keys :req-un [::db/pool ::version ::uri ::sprops]))
(defmethod ig/init-key ::handler
[_ {:keys [pool] :as cfg}]
[_ {:keys [pool sprops version] :as cfg}]
(fn [_]
(db/with-atomic [conn pool]
(try
(acquire-lock conn)
(handler (assoc cfg :conn conn))
(finally
(release-all-locks conn))))))
(let [instance-id (:instance-id sprops)]
(-> (retrieve-stats pool version)
(assoc :instance-id instance-id)
(send! cfg)))))
(defn- acquire-lock
[conn]
(db/exec-one! conn ["select pg_advisory_lock(87562985867332);"]))
(defn- release-all-locks
[conn]
(db/exec-one! conn ["select pg_advisory_unlock_all();"]))
(defn- handler
[{:keys [sprops] :as cfg}]
(let [instance-id (:instance-id sprops)
data (retrieve-stats cfg)
data (assoc data :instance-id instance-id)
response (http/send! {:method :post
:uri (:uri cfg)
:headers {"content-type" "application/json"}
:body (json/write-str data)})]
(defn- send!
[data cfg]
(let [response (http/send! {:method :post
:uri (:uri cfg)
:headers {"content-type" "application/json"}
:body (json/write-str data)})]
(when (> (:status response) 206)
(ex/raise :type :internal
:code :invalid-response
:context {:status (:status response)
:body (:body response)}))))
:response-status (:status response)
:response-body (:body response)))))
(defn retrieve-num-teams
(defn- retrieve-num-teams
[conn]
(-> (db/exec-one! conn ["select count(*) as count from team;"]) :count))
(defn retrieve-num-projects
(defn- retrieve-num-projects
[conn]
(-> (db/exec-one! conn ["select count(*) as count from project;"]) :count))
(defn retrieve-num-files
(defn- retrieve-num-files
[conn]
(-> (db/exec-one! conn ["select count(*) as count from project;"]) :count))
(-> (db/exec-one! conn ["select count(*) as count from file;"]) :count))
(defn- retrieve-num-users
[conn]
(-> (db/exec-one! conn ["select count(*) as count from profile;"]) :count))
(defn- retrieve-num-fonts
[conn]
(-> (db/exec-one! conn ["select count(*) as count from team_font_variant;"]) :count))
(defn- retrieve-num-comments
[conn]
(-> (db/exec-one! conn ["select count(*) as count from comment;"]) :count))
(def sql:team-averages
"with projects_by_team as (
@ -98,7 +95,6 @@
select t.id, count(tp.profile_id) as num_users
from team as t
left join team_profile_rel as tp on(tp.team_id = t.id)
where t.is_default = false
group by 1
)
select (select avg(num_projects)::integer from projects_by_team) as avg_projects_on_team,
@ -110,20 +106,20 @@
(select avg(num_users)::integer from users_by_team) as avg_users_on_team,
(select max(num_users)::integer from users_by_team) as max_users_on_team;")
(defn retrieve-team-averages
(defn- retrieve-team-averages
[conn]
(->> [sql:team-averages]
(db/exec-one! conn)))
(defn retrieve-jvm-stats
(defn- retrieve-jvm-stats
[]
(let [^Runtime runtime (Runtime/getRuntime)]
{:jvm-heap-current (.totalMemory runtime)
:jvm-heap-max (.maxMemory runtime)
:jvm-cpus (.availableProcessors runtime)}))
(defn- retrieve-stats
[{:keys [conn version]}]
(defn retrieve-stats
[conn version]
(let [referer (if (cfg/get :telemetry-with-taiga)
"taiga"
(cfg/get :telemetry-referer))]
@ -131,7 +127,10 @@
:referer referer
:total-teams (retrieve-num-teams conn)
:total-projects (retrieve-num-projects conn)
:total-files (retrieve-num-files conn)}
:total-files (retrieve-num-files conn)
:total-users (retrieve-num-users conn)
:total-fonts (retrieve-num-fonts conn)
:total-comments (retrieve-num-comments conn)}
(d/merge
(retrieve-team-averages conn)
(retrieve-jvm-stats))

32
backend/src/app/util/blob.clj
View File

@ -10,6 +10,7 @@
(:require
[app.common.transit :as t]
[app.config :as cf]
[app.util.fressian :as fres]
[taoensso.nippy :as n])
(:import
java.io.ByteArrayInputStream
@ -21,23 +22,28 @@
net.jpountz.lz4.LZ4FastDecompressor
net.jpountz.lz4.LZ4Compressor))
(set! *warn-on-reflection* true)
(def lz4-factory (LZ4Factory/fastestInstance))
(declare decode-v1)
(declare decode-v2)
(declare decode-v3)
(declare decode-v4)
(declare encode-v1)
(declare encode-v2)
(declare encode-v3)
(declare encode-v4)
(defn encode
([data] (encode data nil))
([data {:keys [version]}]
(let [version (or version (cf/get :default-blob-version 1))]
(let [version (or version (cf/get :default-blob-version 3))]
(case (long version)
1 (encode-v1 data)
2 (encode-v2 data)
3 (encode-v3 data)
4 (encode-v4 data)
(throw (ex-info "unsupported version" {:version version}))))))
(defn decode
@ -51,6 +57,7 @@
1 (decode-v1 data ulen)
2 (decode-v2 data ulen)
3 (decode-v3 data ulen)
4 (decode-v4 data ulen)
(throw (ex-info "unsupported version" {:version version}))))))
;; --- IMPL
@ -122,3 +129,26 @@
(Zstd/decompressByteArray ^bytes udata 0 ulen
^bytes cdata 6 (- (alength cdata) 6))
(t/decode udata {:type :json})))
(defn- encode-v4
[data]
(let [data (fres/encode data)
dlen (alength ^bytes data)
mlen (Zstd/compressBound dlen)
cdata (byte-array mlen)
clen (Zstd/compressByteArray ^bytes cdata 0 mlen
^bytes data 0 dlen
0)]
(with-open [^ByteArrayOutputStream baos (ByteArrayOutputStream. (+ (alength cdata) 2 4))
^DataOutputStream dos (DataOutputStream. baos)]
(.writeShort dos (short 4)) ;; version number
(.writeInt dos (int dlen))
(.write dos ^bytes cdata (int 0) clen)
(.toByteArray baos))))
(defn- decode-v4
[^bytes cdata ^long ulen]
(let [udata (byte-array ulen)]
(Zstd/decompressByteArray ^bytes udata 0 ulen
^bytes cdata 6 (- (alength cdata) 6))
(fres/decode udata)))

2
backend/src/app/util/emails.clj
View File

@ -206,7 +206,7 @@
:content html}]))}))
(s/def ::priority #{:high :low})
(s/def ::to (s/or :sigle ::us/email
(s/def ::to (s/or :single ::us/email
:multi (s/coll-of ::us/email)))
(s/def ::from ::us/email)
(s/def ::reply-to ::us/email)

281
backend/src/app/util/fressian.clj Normal file
View File

@ -0,0 +1,281 @@
;; 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) UXBOX Labs SL
(ns app.util.fressian
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[clojure.data.fressian :as fres])
(:import
app.common.geom.matrix.Matrix
app.common.geom.point.Point
clojure.lang.Ratio
java.io.ByteArrayInputStream
java.io.ByteArrayOutputStream
java.time.Instant
java.time.OffsetDateTime
org.fressian.Reader
org.fressian.StreamingWriter
org.fressian.Writer
org.fressian.handlers.ReadHandler
org.fressian.handlers.WriteHandler))
;; --- MISC
(set! *warn-on-reflection* true)
(defn str->bytes
([^String s]
(str->bytes s "UTF-8"))
([^String s, ^String encoding]
(.getBytes s encoding)))
(defn write-named
[tag ^Writer w s]
(.writeTag w tag 2)
(.writeObject w (namespace s) true)
(.writeObject w (name s) true))
(defn write-list-like
([^Writer w tag o]
(.writeTag w tag 1)
(.writeList w o)))
(defn read-list-like
[^Reader rdr build-fn]
(build-fn (.readObject rdr)))
(defn write-map-like
"Writes a map as Fressian with the tag 'map' and all keys cached."
[^Writer w tag m]
(.writeTag w tag 1)
(.beginClosedList ^StreamingWriter w)
(loop [items (seq m)]
(when-let [^clojure.lang.MapEntry item (first items)]
(.writeObject w (.key item) true)
(.writeObject w (.val item))
(recur (rest items))))
(.endList ^StreamingWriter w))
(defn read-map-like
[^Reader rdr]
(let [kvs ^java.util.List (.readObject rdr)]
(if (< (.size kvs) 16)
(clojure.lang.PersistentArrayMap. (.toArray kvs))
(clojure.lang.PersistentHashMap/create (seq kvs)))))
(def write-handlers
{ Character
{"char"
(reify WriteHandler
(write [_ w ch]
(.writeTag w "char" 1)
(.writeInt w (int ch))))}
app.common.geom.point.Point
{"penpot/point"
(reify WriteHandler
(write [_ w o]
(.writeTag ^Writer w "penpot/point" 1)
(.writeList ^Writer w (java.util.List/of (.-x ^Point o) (.-y ^Point o)))))}
app.common.geom.matrix.Matrix
{"penpot/matrix"
(reify WriteHandler
(write [_ w o]
(.writeTag ^Writer w "penpot/matrix" 1)
(.writeList ^Writer w (java.util.List/of (.-a ^Matrix o)
(.-b ^Matrix o)
(.-c ^Matrix o)
(.-d ^Matrix o)
(.-e ^Matrix o)
(.-f ^Matrix o)))))}
Instant
{"java/instant"
(reify WriteHandler
(write [_ w ch]
(.writeTag w "java/instant" 1)
(.writeInt w (.toEpochMilli ^Instant ch))))}
OffsetDateTime
{"java/instant"
(reify WriteHandler
(write [_ w ch]
(.writeTag w "java/instant" 1)
(.writeInt w (.toEpochMilli ^Instant (.toInstant ^OffsetDateTime ch)))))}
Ratio
{"ratio"
(reify WriteHandler
(write [_ w n]
(.writeTag w "ratio" 2)
(.writeObject w (.numerator ^Ratio n))
(.writeObject w (.denominator ^Ratio n))))}
clojure.lang.IPersistentMap
{"clj/map"
(reify WriteHandler
(write [_ w d]
(write-map-like w "clj/map" d)))}
clojure.lang.Keyword
{"clj/keyword"
(reify WriteHandler
(write [_ w s]
(write-named "clj/keyword" w s)))}
clojure.lang.BigInt
{"bigint"
(reify WriteHandler
(write [_ w d]
(let [^BigInteger bi (if (instance? clojure.lang.BigInt d)
(.toBigInteger ^clojure.lang.BigInt d)
d)]
(.writeTag w "bigint" 1)
(.writeBytes w (.toByteArray bi)))))}
;; Persistent set
clojure.lang.IPersistentSet
{"clj/set"
(reify WriteHandler
(write [_ w o]
(write-list-like w "clj/set" o)))}
;; Persistent vector
clojure.lang.IPersistentVector
{"clj/vector"
(reify WriteHandler
(write [_ w o]
(write-list-like w "clj/vector" o)))}
;; Persistent list
clojure.lang.IPersistentList
{"clj/list"
(reify WriteHandler
(write [_ w o]
(write-list-like w "clj/list" o)))}
;; Persistent seq & lazy seqs
clojure.lang.ISeq
{"clj/seq"
(reify WriteHandler
(write [_ w o]
(write-list-like w "clj/seq" o)))}
})
(def read-handlers
{"bigint"
(reify ReadHandler
(read [_ rdr _ _]
(let [^bytes bibytes (.readObject rdr)]
(bigint (BigInteger. bibytes)))))
"byte"
(reify ReadHandler
(read [_ rdr _ _]
(byte (.readObject rdr))))
"penpot/matrix"
(reify ReadHandler
(read [_ rdr _ _]
(let [^java.util.List x (.readObject rdr)]
(Matrix. (.get x 0) (.get x 1) (.get x 2) (.get x 3) (.get x 4) (.get x 5)))))
"penpot/point"
(reify ReadHandler
(read [_ rdr _ _]
(let [^java.util.List x (.readObject rdr)]
(Point. (.get x 0) (.get x 1)))))
"char"
(reify ReadHandler
(read [_ rdr _ _]
(char (.readObject rdr))))
"java/instant"
(reify ReadHandler
(read [_ rdr _ _]
(Instant/ofEpochMilli (.readInt rdr))))
"clj/ratio"
(reify ReadHandler
(read [_ rdr _ _]
(Ratio. (biginteger (.readObject rdr))
(biginteger (.readObject rdr)))))
"clj/keyword"
(reify ReadHandler
(read [_ rdr _ _]
(keyword (.readObject rdr) (.readObject rdr))))
"clj/map"
(reify ReadHandler
(read [_ rdr _ _]
(read-map-like rdr)))
"clj/set"
(reify ReadHandler
(read [_ rdr _ _]
(read-list-like rdr set)))
"clj/vector"
(reify ReadHandler
(read [_ rdr _ _]
(read-list-like rdr vec)))
"clj/list"
(reify ReadHandler
(read [_ rdr _ _]
(read-list-like rdr #(apply list %))))
"clj/seq"
(reify ReadHandler
(read [_ rdr _ _]
(read-list-like rdr sequence)))
})
(def write-handler-lookup
(-> write-handlers
fres/associative-lookup
fres/inheritance-lookup))
(def read-handler-lookup
(-> read-handlers
(fres/associative-lookup)))
;; --- Low-Level Api
(defn reader
[istream]
(fres/create-reader istream :handlers read-handler-lookup))
(defn writer
[ostream]
(fres/create-writer ostream :handlers write-handler-lookup))
(defn read!
[reader]
(fres/read-object reader))
(defn write!
[writer data]
(fres/write-object writer data))
;; --- High-Level Api
(defn encode
[data]
(with-open [out (ByteArrayOutputStream.)]
(write! (writer out) data)
(.toByteArray out)))
(defn decode
[data]
(with-open [input (ByteArrayInputStream. ^bytes data)]
(read! (reader input))))

2
backend/src/app/util/migrations.clj
View File

@ -20,7 +20,7 @@
;; --- Implementation
(defn- registered?
"Check if concrete migration is already registred."
"Check if concrete migration is already registered."
[pool modname stepname]
(let [sql "select * from migrations where module=? and step=?"
rows (jdbc/execute! pool [sql modname stepname])]

27
backend/src/app/util/time.clj
View File

@ -17,6 +17,8 @@
java.time.ZonedDateTime
java.time.format.DateTimeFormatter
java.time.temporal.TemporalAmount
java.time.temporal.TemporalUnit
java.time.temporal.ChronoUnit
java.util.Date
org.apache.logging.log4j.core.util.CronExpression))
@ -54,15 +56,30 @@
:else
(obj->duration ms-or-obj)))
(defn duration-between
{:deprecated true}
[t1 t2]
(Duration/between t1 t2))
(defn diff
[t1 t2]
(Duration/between t1 t2))
(defn truncate
[o unit]
(let [unit (if (instance? TemporalUnit unit)
unit
(case unit
:nanos ChronoUnit/NANOS
:millis ChronoUnit/MILLIS
:micros ChronoUnit/MICROS
:seconds ChronoUnit/SECONDS
:minutes ChronoUnit/MINUTES))]
(cond
(instance? Instant o)
(.truncatedTo ^Instant o ^TemporalUnit unit)
(instance? Duration o)
(.truncatedTo ^Duration o ^TemporalUnit unit)
:else
(throw (IllegalArgumentException. "only instant and duration allowed")))))
(s/def ::duration
(s/conformer
(fn [v]

202
backend/src/app/util/websocket.clj Normal file
View File

@ -0,0 +1,202 @@
;; 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) UXBOX Labs SL
(ns app.util.websocket
"A general protocol implementation on top of websockets."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.transit :as t]
[app.metrics :as mtx]
[app.util.time :as dt]
[clojure.core.async :as a]
[yetti.websocket :as yws])
(:import
java.nio.ByteBuffer))
(declare decode-beat)
(declare encode-beat)
(declare process-heartbeat)
(declare process-input)
(declare process-output)
(declare ws-ping!)
(declare ws-send!)
(defmacro call-mtx
[definitions name & args]
`(when-let [mtx-fn# (some-> ~definitions ~name ::mtx/fn)]
(mtx-fn# ~@args)))
(def noop (constantly nil))
(defn handler
"A WebSocket upgrade handler factory. Returns a handler that can be
used to upgrade to websocket connection. This handler implements the
basic custom protocol on top of websocket connection with all the
borring stuff already handled (lifecycle, heartbeat,...).
The provided function should have the `(fn [ws msg])` signature.
It also accepts some options that allows you parametrize the
protocol behavior. The options map will be used as-as for the
initial data of the `ws` data structure"
([handle-message] (handler handle-message {}))
([handle-message {:keys [::input-buff-size
::output-buff-size
::idle-timeout
::metrics]
:or {input-buff-size 64
output-buff-size 64
idle-timeout 30000}
:as options}]
(fn [_]
(let [input-ch (a/chan input-buff-size)
output-ch (a/chan output-buff-size)
pong-ch (a/chan (a/sliding-buffer 6))
close-ch (a/chan)
options (-> options
(assoc ::input-ch input-ch)
(assoc ::output-ch output-ch)
(assoc ::close-ch close-ch)
(dissoc ::metrics))
terminated (atom false)
created-at (dt/now)
on-terminate
(fn [& _args]
(when (compare-and-set! terminated false true)
(call-mtx metrics :connections {:cmd :dec :by 1})
(call-mtx metrics :sessions {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
(a/close! close-ch)
(a/close! pong-ch)
(a/close! output-ch)
(a/close! input-ch)))
on-error
(fn [_ error]
(on-terminate)
(when-not (or (instance? org.eclipse.jetty.websocket.api.exceptions.WebSocketTimeoutException error)
(instance? java.nio.channels.ClosedChannelException error))
(l/error :hint (ex-message error) :cause error)))
on-connect
(fn [conn]
(call-mtx metrics :connections {:cmd :inc :by 1})
(let [wsp (atom (assoc options ::conn conn))]
;; Handle heartbeat
(yws/idle-timeout! conn (dt/duration idle-timeout))
(-> @wsp
(assoc ::pong-ch pong-ch)
(assoc ::on-close on-terminate)
(process-heartbeat))
;; Forward all messages from output-ch to the websocket
;; connection
(a/go-loop []
(when-let [val (a/<! output-ch)]
(call-mtx metrics :messages {:labels ["send"]})
(a/<! (ws-send! conn (t/encode-str val)))
(recur)))
;; React on messages received from the client
(process-input wsp handle-message)))
on-message
(fn [_ message]
(call-mtx metrics :messages {:labels ["recv"]})
(try
(let [message (t/decode-str message)]
(a/offer! input-ch message))
(catch Throwable e
(l/warn :hint "error on decoding incoming message from websocket"
:wsmsg (pr-str message)
:cause e)
(on-terminate))))
on-pong
(fn [_ buffer]
(a/>!! pong-ch buffer))]
{:on-connect on-connect
:on-error on-error
:on-close on-terminate
:on-text on-message
:on-pong on-pong}))))
(defn- ws-send!
[conn s]
(let [ch (a/chan 1)]
(yws/send! conn s (fn [e]
(when e (a/offer! ch e))
(a/close! ch)))
ch))
(defn- ws-ping!
[conn s]
(let [ch (a/chan 1)]
(yws/ping! conn s (fn [e]
(when e (a/offer! ch e))
(a/close! ch)))
ch))
(defn- encode-beat
[n]
(doto (ByteBuffer/allocate 8)
(.putLong n)
(.rewind)))
(defn- decode-beat
[^ByteBuffer buffer]
(when (= 8 (.capacity buffer))
(.rewind buffer)
(.getLong buffer)))
(defn- process-input
[wsp handler]
(let [{:keys [::input-ch ::output-ch ::close-ch]} @wsp]
(a/go
(a/<! (handler wsp {:type :connect}))
(a/<! (a/go-loop []
(when-let [request (a/<! input-ch)]
(let [[val port] (a/alts! [(handler wsp request) close-ch])]
(when-not (= port close-ch)
(cond
(ex/ex-info? val)
(a/>! output-ch {:type :error :error (ex-data val)})
(ex/exception? val)
(a/>! output-ch {:type :error :error {:message (ex-message val)}})
(map? val)
(a/>! output-ch (cond-> val (:request-id request) (assoc :request-id (:request-id request)))))
(recur))))))
(a/<! (handler wsp {:type :disconnect})))))
(defn- process-heartbeat
[{:keys [::conn ::close-ch ::on-close ::pong-ch
::heartbeat-interval ::max-missed-heartbeats]
:or {heartbeat-interval 2000
max-missed-heartbeats 4}}]
(let [beats (atom #{})]
(a/go-loop [i 0]
(let [[_ port] (a/alts! [close-ch (a/timeout heartbeat-interval)])]
(when (and (yws/connected? conn)
(not= port close-ch))
(a/<! (ws-ping! conn (encode-beat i)))
(let [issued (swap! beats conj (long i))]
(if (>= (count issued) max-missed-heartbeats)
(on-close conn -1 "heartbeat-timeout")
(recur (inc i)))))))
(a/go-loop []
(when-let [buffer (a/<! pong-ch)]
(swap! beats disj (decode-beat buffer))
(recur)))))

2
backend/src/app/worker.clj
View File

@ -465,7 +465,7 @@
:type :summary
:quantiles []
:name "tasks_checkout_timing"
:help "Latency measured between scheduld_at and execution time."
:help "Latency measured between scheduled_at and execution time."
:wrap (fn [rootf mobj]
(let [mdata (meta rootf)
origf (::original mdata rootf)]

4
backend/test/app/services_files_test.clj
View File

@ -174,12 +174,12 @@
:type :image
:metadata {:id (:id fmo1)}}}]})]
;; run the task inmediatelly
;; run the task immediately
(let [task (:app.tasks.file-media-gc/handler th/*system*)
res (task {})]
(t/is (= 0 (:processed res))))
;; make the file ellegible for GC waiting 300ms (configured
;; make the file eligible for GC waiting 300ms (configured
;; timeout for testing)
(th/sleep 300)

8
backend/test/app/services_management_test.clj
View File

@ -52,7 +52,7 @@
;; (th/print-result! out)
;; Check tha tresult is correct
;; Check that result is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
@ -127,7 +127,7 @@
;; (th/print-result! out)
;; Check tha tresult is correct
;; Check that result is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
@ -183,7 +183,7 @@
:name "project 1 (copy)"}
out (th/mutation! data)]
;; Check tha tresult is correct
;; Check that result is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
@ -254,7 +254,7 @@
:name "project 1 (copy)"}
out (th/mutation! data)]
;; Check tha tresult is correct
;; Check that result is correct
(t/is (nil? (:error out)))
(let [result (:result out)]

4
backend/test/app/storage_test.clj
View File

@ -68,7 +68,7 @@
(t/is (true? (sto/del-object storage object)))
;; retrieving the same object should be not nil because the
;; deletion is not inmediate
;; deletion is not immediate
(t/is (some? (sto/get-object-data storage object)))
(t/is (some? (sto/get-object-url storage object)))
(t/is (some? (sto/get-object-path storage object)))
@ -248,7 +248,7 @@
(th/sleep 200)
;; storage_pending table should have the object
;; registred independently of the aborted transaction.
;; registered independently of the aborted transaction.
(let [rows (db/exec! th/*pool* ["select * from storage_pending"])]
(t/is (= 1 (count rows))))

46
backend/test/app/tasks_telemetry_test.clj Normal file
View File

@ -0,0 +1,46 @@
;; 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) UXBOX Labs SL
(ns app.tasks-telemetry-test
(:require
[app.db :as db]
[app.emails :as emails]
[app.test-helpers :as th]
[app.util.time :as dt]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest test-base-report-data-structure
(with-mocks [mock {:target 'app.tasks.telemetry/send!
:return nil}]
(let [task-fn (-> th/*system* :app.worker/registry :telemetry)
prof (th/create-profile* 1 {:is-active true})]
;; run the task
(task-fn nil)
(t/is (:called? @mock))
(let [[data] (-> @mock :call-args)]
(t/is (contains? data :total-fonts))
(t/is (contains? data :total-users))
(t/is (contains? data :total-projects))
(t/is (contains? data :total-files))
(t/is (contains? data :total-teams))
(t/is (contains? data :total-comments))
(t/is (contains? data :instance-id))
(t/is (contains? data :jvm-cpus))
(t/is (contains? data :jvm-heap-max))
(t/is (contains? data :max-users-on-team))
(t/is (contains? data :avg-users-on-team))
(t/is (contains? data :max-files-on-project))
(t/is (contains? data :avg-files-on-project))
(t/is (contains? data :max-projects-on-team))
(t/is (contains? data :avg-files-on-project))
(t/is (contains? data :version))))))

1
backend/test/app/test_helpers.clj
View File

@ -57,6 +57,7 @@
:app.http/server
:app.http/router
:app.notifications/handler
:app.loggers.sentry/reporter
:app.http.oauth/google
:app.http.oauth/gitlab
:app.http.oauth/github

53
common/deps.edn
View File

@ -1,38 +1,39 @@
{:deps
{org.clojure/clojure {:mvn/version "1.10.3"}
org.clojure/data.json {:mvn/version "2.3.1"}
org.clojure/data.json {:mvn/version "2.4.0"}
org.clojure/tools.cli {:mvn/version "1.0.206"}
metosin/jsonista {:mvn/version "0.3.3"}
org.clojure/clojurescript {:mvn/version "1.10.844"}
metosin/jsonista {:mvn/version "0.3.5"}
org.clojure/clojurescript {:mvn/version "1.10.914"}
;; Logging
org.clojure/tools.logging {:mvn/version "1.2.3"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.17.0"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.17.0"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.17.0"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.17.0"}
org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.17.0"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.17.1"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.17.1"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.17.1"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.17.1"}
org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.17.1"}
org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
selmer/selmer {:mvn/version "1.12.40"}
expound/expound {:mvn/version "0.8.9"}
selmer/selmer {:mvn/version "1.12.49"}
criterium/criterium {:mvn/version "0.4.6"}
expound/expound {:mvn/version "0.9.0"}
com.cognitect/transit-clj {:mvn/version "1.0.324"}
com.cognitect/transit-cljs {:mvn/version "0.8.269"}
java-http-clj/java-http-clj {:mvn/version "0.4.2"}
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
funcool/promesa {:mvn/version "6.0.1"}
funcool/cuerdas {:mvn/version "2021.05.29-0"}
funcool/promesa {:mvn/version "6.0.2"}
funcool/cuerdas {:mvn/version "2022.01.14-391"}
lambdaisland/uri {:mvn/version "1.4.70"
lambdaisland/uri {:mvn/version "1.12.89"
:exclusions [org.clojure/data.json]}
frankiesardo/linked {:mvn/version "1.3.0"}
danlentz/clj-uuid {:mvn/version "0.1.9"}
commons-io/commons-io {:mvn/version "2.8.0"}
commons-io/commons-io {:mvn/version "2.11.0"}
com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
;; exception printing
fipp/fipp {:mvn/version "0.6.24"}
fipp/fipp {:mvn/version "0.6.25"}
io.aviso/pretty {:mvn/version "1.1.1"}
environ/environ {:mvn/version "1.2.0"}}
:paths ["src"]
@ -42,25 +43,17 @@
{org.clojure/tools.namespace {:mvn/version "RELEASE"}
org.clojure/test.check {:mvn/version "RELEASE"}
org.clojure/tools.deps.alpha {:mvn/version "RELEASE"}
thheller/shadow-cljs {:mvn/version "2.12.6"}
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
thheller/shadow-cljs {:mvn/version "2.16.12"}
criterium/criterium {:mvn/version "RELEASE"}
mockery/mockery {:mvn/version "RELEASE"}}
:extra-paths ["test" "dev"]}
:repl
{:extra-deps
{com.bhauman/rebel-readline {:mvn/version "RELEASE"}}
:main-opts ["-m" "rebel-readline.main"]}
:kaocha
{:extra-deps {lambdaisland/kaocha {:mvn/version "RELEASE"}}
:main-opts ["-m" "kaocha.runner"]}
:test
{:extra-paths ["test"]
:extra-deps {io.github.cognitect-labs/test-runner
{:git/url "https://github.com/cognitect-labs/test-runner.git"
:sha "705ad25bbf0228b1c38d0244a36001c2987d7337"}}
:extra-deps
{io.github.cognitect-labs/test-runner
{:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
:exec-fn cognitect.test-runner.api/test}
:shadow-cljs

7
common/package.json
View File

@ -6,7 +6,14 @@
"dependencies": {
"luxon": "^1.27.0"
},
"scripts": {
"compile-and-watch-test": "clojure -M:dev:shadow-cljs watch test",
"compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
"run-test": "node target/test.js",
"test": "yarn run compile-test && yarn run run-test"
},
"devDependencies": {
"shadow-cljs": "2.16.12",
"source-map-support": "^0.5.19",
"ws": "^7.4.6"
}

9
common/scripts/repl Executable file
View File

@ -0,0 +1,9 @@
#!/usr/bin/env bash
export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
export OPTIONS="-A:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
export OPTIONS_EVAL="nil"
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
set -ex
exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -m rebel-readline.main

23
common/shadow-cljs.edn
View File

@ -6,12 +6,29 @@
:builds
{:test
{:target :node-test
:output-to "target/tests.js"
:output-to "target/test.js"
:output-dir "target/test/"
:ns-regexp "^app.common.*-test$"
;; :autorun true
:autorun true
:compiler-options
{:output-feature-set :es-next
:output-wrapper false
:warnings {:fn-deprecated false}}}}}
:source-map true
:source-map-include-sources-content true
:source-map-detail-level :all
:warnings {:fn-deprecated false}}}
:bench
{:target :node-script
:output-to "target/bench.js"
:output-dir "target/bench/"
:main bench/main
:devtools {:autoload false}
:compiler-options
{:output-feature-set :es-next
:output-wrapper false}}}
}

2
common/src/app/common/attrs.cljc
View File

@ -9,7 +9,7 @@
;; Extract some attributes of a list of shapes.
;; For each attribute, if the value is the same in all shapes,
;; wll take this value. If there is any shape that is different,
;; will take this value. If there is any shape that is different,
;; the value of the attribute will be the keyword :multiple.
;;
;; If some shape has the value nil in any attribute, it's

18
common/src/app/common/colors.cljc Normal file
View File

@ -0,0 +1,18 @@
;; 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) UXBOX Labs SL
(ns app.common.colors
(:refer-clojure :exclude [test]))
(def black "#000000")
(def canvas "#E8E9EA")
(def default-layout "#DE4762")
(def gray-20 "#B1B2B5")
(def gray-30 "#7B7D85")
(def info "#59B9E2")
(def test "#fabada")
(def white "#FFFFFF")

6
common/src/app/common/data.cljc
View File

@ -157,7 +157,7 @@
"Return a map without the keys provided
in the `keys` parameter."
[data keys]
(when data
(when (map? data)
(persistent!
(reduce #(dissoc! %1 %2) (transient data) keys))))
@ -201,7 +201,7 @@
"Maps a function to each pair of values that can be combined inside the
function without repetition.
Optional parmeters:
Optional parameters:
`pred?` A predicate that if not satisfied won't process the pair
`target?` A collection that will be used as seed to be stored
@ -497,7 +497,7 @@
(keyword (str prefix kw))))
(defn tap
"Simpilar to the tap in rxjs but for plain collections"
"Similar to the tap in rxjs but for plain collections"
[f coll]
(f coll)
coll)

15
common/src/app/common/exceptions.cljc
View File

@ -12,26 +12,23 @@
(s/def ::type keyword?)
(s/def ::code keyword?)
(s/def ::mesage string?)
(s/def ::hint string?)
(s/def ::cause #?(:clj #(instance? Throwable %)
:cljs #(instance? js/Error %)))
(s/def ::error-params
(s/keys :req-un [::type]
:opt-un [::code
::hint
::mesage
::cause]))
(defn error
[& {:keys [message hint cause] :as params}]
[& {:keys [hint cause ::data] :as params}]
(s/assert ::error-params params)
(let [message (or message hint "")
payload (-> params
(dissoc :cause)
(dissoc :message)
(assoc :hint message))]
(ex-info message payload cause)))
(let [payload (-> params
(dissoc :cause ::data)
(merge data))]
(ex-info hint payload cause)))
(defmacro raise
[& args]

112
common/src/app/common/file_builder.cljc
View File

@ -12,7 +12,6 @@
[app.common.geom.shapes :as gsh]
[app.common.pages.changes :as ch]
[app.common.pages.init :as init]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
@ -21,15 +20,14 @@
(def conjv (fnil conj []))
(def conjs (fnil conj #{}))
;; This flag controls if we should execute spec validation after every commit
(def verify-on-commit? true)
(defn- commit-change
([file change]
(commit-change file change nil))
([file change {:keys [add-container?]
:or {add-container? false}}]
([file change {:keys [add-container?
fail-on-spec?]
:or {add-container? false
fail-on-spec? false}}]
(let [component-id (:current-component-id file)
change (cond-> change
(and add-container? (some? component-id))
@ -39,11 +37,20 @@
(assoc :page-id (:current-page-id file)
:frame-id (:current-frame-id file)))]
(when verify-on-commit?
(us/assert ::spec/change change))
(-> file
(update :changes conjv change)
(update :data ch/process-changes [change] verify-on-commit?)))))
(when fail-on-spec?
(us/verify :app.common.pages.spec/change change))
(let [valid? (us/valid? :app.common.pages.spec/change change)]
#?(:cljs
(when-not valid? (.warn js/console "Invalid shape" (clj->js change))))
(cond-> file
valid?
(-> (update :changes conjv change)
(update :data ch/process-changes [change] false))
(not valid?)
(update :errors conjv change))))))
(defn- lookup-objects
([file]
@ -51,20 +58,21 @@
(get-in file [:data :components (:current-component-id file) :objects])
(get-in file [:data :pages-index (:current-page-id file) :objects]))))
(defn- lookup-shape [file shape-id]
(defn lookup-shape [file shape-id]
(-> (lookup-objects file)
(get shape-id)))
(defn- commit-shape [file obj]
(let [parent-id (-> file :parent-stack peek)]
(-> file
(commit-change
{:type :add-obj
:id (:id obj)
:obj obj
:parent-id parent-id}
(let [parent-id (-> file :parent-stack peek)
change {:type :add-obj
:id (:id obj)
:obj obj
:parent-id parent-id}
{:add-container? true}))))
fail-on-spec? (or (= :group (:type obj))
(= :frame (:type obj)))]
(commit-change file change {:add-container? true :fail-on-spec? fail-on-spec?})))
(defn setup-rect-selrect [obj]
(let [rect (select-keys obj [:x :y :width :height])
@ -321,16 +329,11 @@
(update :parent-stack pop))))
(defn create-shape [file type data]
(let [frame-id (:current-frame-id file)
frame (when-not (= frame-id root-frame)
(lookup-shape file frame-id))
obj (-> (init/make-minimal-shape type)
(let [obj (-> (init/make-minimal-shape type)
(merge data)
(check-name file :type)
(setup-selrect)
(d/without-nils))
obj (cond-> obj
frame (gsh/translate-from-frame frame))]
(d/without-nils))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
@ -426,35 +429,36 @@
(defn add-interaction
[file from-id interaction-src]
(assert (some? (lookup-shape file from-id)) (str "Cannot locate shape with id " from-id))
(let [shape (lookup-shape file from-id)]
(if (nil? shape)
file
(let [{:keys [event-type action-type]} (read-classifier interaction-src)
{:keys [delay]} (read-event-opts interaction-src)
{:keys [destination overlay-pos-type overlay-position url
close-click-outside background-overlay preserve-scroll]}
(read-action-opts interaction-src)
(let [{:keys [event-type action-type]} (read-classifier interaction-src)
{:keys [delay]} (read-event-opts interaction-src)
{:keys [destination overlay-pos-type overlay-position url
close-click-outside background-overlay preserve-scroll]}
(read-action-opts interaction-src)
interactions (-> shape
:interactions
(conjv
(d/without-nils {:event-type event-type
:action-type action-type
:delay delay
:destination destination
:overlay-pos-type overlay-pos-type
:overlay-position overlay-position
:url url
:close-click-outside close-click-outside
:background-overlay background-overlay
:preserve-scroll preserve-scroll})))]
(commit-change
file
{:type :mod-obj
:page-id (:current-page-id file)
:id from-id
interactions (-> (lookup-shape file from-id)
:interactions
(conjv
(d/without-nils {:event-type event-type
:action-type action-type
:delay delay
:destination destination
:overlay-pos-type overlay-pos-type
:overlay-position overlay-position
:url url
:close-click-outside close-click-outside
:background-overlay background-overlay
:preserve-scroll preserve-scroll})))]
(commit-change
file
{:type :mod-obj
:page-id (:current-page-id file)
:id from-id
:operations
[{:type :set :attr :interactions :val interactions}]})))
:operations
[{:type :set :attr :interactions :val interactions}]})))))
(defn generate-changes
[file]

24
common/src/app/common/geom/align.cljc
View File

@ -6,7 +6,9 @@
(ns app.common.geom.align
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :refer [get-children]]
[clojure.spec.alpha :as s]))
;; --- Alignment
@ -15,23 +17,13 @@
(declare calc-align-pos)
;; TODO: revisit on how to reuse code and dont have this function
;; duplicated because the implementation right now differs from the
;; original function.
;; Duplicated from pages/helpers to remove cyclic dependencies
(defn- get-children [id objects]
(let [shapes (vec (get-in objects [id :shapes]))]
(if shapes
(into shapes (mapcat #(get-children % objects)) shapes)
[])))
(defn- recursive-move
"Move the shape and all its recursive children."
[shape dpoint objects]
(let [children-ids (get-children (:id shape) objects)
children (map #(get objects %) children-ids)]
(map #(gsh/move % dpoint) (cons shape children))))
(->> (get-children (:id shape) objects)
(map (d/getf objects))
(cons shape)
(map #(gsh/move % dpoint))))
(defn align-to-rect
"Move the shape so that it is aligned with the given rectangle
@ -81,7 +73,7 @@
"Distribute equally the space between shapes in the given axis. If
there is no space enough, it does nothing. It takes into account
the form of the shape and the rotation, what is distributed is
the wrapping recangles of the shapes. If any shape is a group,
the wrapping rectangles of the shapes. If any shape is a group,
move also all of its recursive children."
[shapes axis objects]
(let [coord (if (= axis :horizontal) :x :y)
@ -119,7 +111,7 @@
(mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
sorted-shapes deltas)))))
;; Adjusto to viewport
;; Adjust to viewport
(defn adjust-to-viewport
([viewport srect] (adjust-to-viewport viewport srect nil))

48
common/src/app/common/geom/matrix.cljc
View File

@ -14,7 +14,12 @@
;; --- Matrix Impl
(defrecord Matrix [a b c d e f]
(defrecord Matrix [^double a
^double b
^double c
^double d
^double e
^double f]
Object
(toString [_]
(str "matrix(" a "," b "," c "," d "," e "," f ")")))
@ -36,15 +41,29 @@
(apply matrix params)))
(defn multiply
([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
(Matrix.
(+ (* m1a m2a) (* m1c m2b))
(+ (* m1b m2a) (* m1d m2b))
(+ (* m1a m2c) (* m1c m2d))
(+ (* m1b m2c) (* m1d m2d))
(+ (* m1a m2e) (* m1c m2f) m1e)
(+ (* m1b m2e) (* m1d m2f) m1f)))
([^Matrix m1 ^Matrix m2]
(let [m1a (.-a m1)
m1b (.-b m1)
m1c (.-c m1)
m1d (.-d m1)
m1e (.-e m1)
m1f (.-f m1)
m2a (.-a m2)
m2b (.-b m2)
m2c (.-c m2)
m2d (.-d m2)
m2e (.-e m2)
m2f (.-f m2)]
(Matrix.
(+ (* m1a m2a) (* m1c m2b))
(+ (* m1b m2a) (* m1d m2b))
(+ (* m1a m2c) (* m1c m2d))
(+ (* m1b m2c) (* m1d m2d))
(+ (* m1a m2e) (* m1c m2f) m1e)
(+ (* m1b m2e) (* m1d m2f) m1f))))
([m1 m2 & others]
(reduce multiply (multiply m1 m2) others)))
@ -53,13 +72,8 @@
values), combine them. Quicker than multiplying them, for this
precise case."
([{m1e :e m1f :f} {m2e :e m2f :f}]
(Matrix.
1
0
0
1
(+ m1e m2e)
(+ m1f m2f)))
(Matrix. 1 0 0 1 (+ m1e m2e) (+ m1f m2f)))
([m1 m2 & others]
(reduce add-translate (add-translate m1 m2) others)))

10
common/src/app/common/geom/point.cljc
View File

@ -187,14 +187,14 @@
(defn round
"Change the precision of the point coordinates."
([point] (round point 0))
([{:keys [x y] :as p} decimanls]
([{:keys [x y] :as p} decimals]
(assert (point? p))
(assert (number? decimanls))
(Point. (mth/precision x decimanls)
(mth/precision y decimanls))))
(assert (number? decimals))
(Point. (mth/precision x decimals)
(mth/precision y decimals))))
(defn transform
"Transform a point applying a matrix transfomation."
"Transform a point applying a matrix transformation."
[{:keys [x y] :as p} {:keys [a b c d e f]}]
(assert (point? p))
(Point. (+ (* x a) (* y c) e)

13
common/src/app/common/geom/shapes.cljc
View File

@ -10,6 +10,7 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes.bool :as gsb]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.constraints :as gct]
[app.common.geom.shapes.intersect :as gin]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
@ -56,8 +57,7 @@
rotation of each shape. Mainly used for multiple selection."
[shapes]
(->> shapes
(gtr/transform-shape)
(map (comp gpr/points->selrect :points))
(map (comp gpr/points->selrect :points gtr/transform-shape))
(gpr/join-selrects)))
(defn translate-to-frame
@ -150,6 +150,7 @@
(d/export gpr/points->rect)
(d/export gpr/center->rect)
(d/export gpr/join-rects)
(d/export gpr/contains-selrect?)
(d/export gtr/move)
(d/export gtr/absolute-move)
@ -163,7 +164,12 @@
(d/export gtr/rotation-modifiers)
(d/export gtr/merge-modifiers)
(d/export gtr/transform-shape)
(d/export gtr/calc-child-modifiers)
(d/export gtr/transform-selrect)
(d/export gtr/modifiers->transform)
(d/export gtr/empty-modifiers?)
;; Constratins
(d/export gct/calc-child-modifiers)
;; PATHS
(d/export gsp/content->selrect)
@ -178,3 +184,4 @@
;; Bool
(d/export gsb/update-bool-selrect)
(d/export gsb/calc-bool-content)

24
common/src/app/common/geom/shapes/bool.cljc
View File

@ -6,21 +6,31 @@
(ns app.common.geom.shapes.bool
(:require
[app.common.data :as d]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr]
[app.common.path.bool :as pb]
[app.common.path.shapes-to-path :as stp]))
(defn calc-bool-content
[shape objects]
(let [extract-content-xf
(comp (map (d/getf objects))
(filter (comp not :hidden))
(map #(stp/convert-to-path % objects))
(map :content))
shapes-content
(into [] extract-content-xf (:shapes shape))]
(pb/content-bool (:bool-type shape) shapes-content)))
(defn update-bool-selrect
"Calculates the selrect+points for the boolean shape"
[shape children objects]
(let [content (->> children
(map #(stp/convert-to-path % objects))
(mapv :content)
(pb/content-bool (:bool-type shape)))
(let [content (calc-bool-content shape objects)
[points selrect]
(if (empty? content)
(let [selrect (gtr/selection-rect children)
@ -29,4 +39,6 @@
(gsp/content->points+selrect shape content))]
(-> shape
(assoc :selrect selrect)
(assoc :points points))))
(assoc :points points)
(assoc :bool-content content))))

16
common/src/app/common/geom/shapes/common.cljc
View File

@ -50,6 +50,22 @@
:width width
:height height})
(defn make-centered-selrect
"Creates a rect given a center and a width and height"
[center width height]
(let [x1 (- (:x center) (/ width 2.0))
y1 (- (:y center) (/ height 2.0))
x2 (+ x1 width)
y2 (+ y1 height)]
{:x x1
:y y1
:x1 x1
:x2 x2
:y1 y1
:y2 y2
:width width
:height height}))
(defn transform-points
([points matrix]
(transform-points points nil matrix))

182
common/src/app/common/geom/shapes/constraints.cljc Normal file
View File

@ -0,0 +1,182 @@
;; 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) UXBOX Labs SL
(ns app.common.geom.shapes.constraints
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.transforms :as gtr]
[app.common.math :as mth]
[app.common.pages.spec :as spec]))
;; Auxiliary methods to work in an specifica axis
(defn get-delta-start [axis rect tr-rect]
(if (= :x axis)
(- (:x1 tr-rect) (:x1 rect))
(- (:y1 tr-rect) (:y1 rect))))
(defn get-delta-end [axis rect tr-rect]
(if (= :x axis)
(- (:x2 tr-rect) (:x2 rect))
(- (:y2 tr-rect) (:y2 rect))))
(defn get-delta-size [axis rect tr-rect]
(if (= :x axis)
(- (:width tr-rect) (:width rect))
(- (:height tr-rect) (:height rect))))
(defn get-delta-center [axis center tr-center]
(if (= :x axis)
(- (:x tr-center) (:x center))
(- (:y tr-center) (:y center))))
(defn get-displacement
([axis delta]
(get-displacement axis delta 0 0))
([axis delta init-x init-y]
(if (= :x axis)
(gpt/point (+ init-x delta) init-y)
(gpt/point init-x (+ init-y delta)))))
(defn get-scale [axis scale]
(if (= :x axis)
(gpt/point scale 1)
(gpt/point 1 scale)))
(defn get-size [axis rect]
(if (= :x axis)
(:width rect)
(:height rect)))
;; Constraint function definitions
(defmulti constraint-modifier (fn [type & _] type))
(defmethod constraint-modifier :start
[_ axis parent _ _ transformed-parent-rect]
(let [parent-rect (:selrect parent)
delta-start (get-delta-start axis parent-rect transformed-parent-rect)]
(if-not (mth/almost-zero? delta-start)
{:displacement (get-displacement axis delta-start)}
{})))
(defmethod constraint-modifier :end
[_ axis parent _ _ transformed-parent-rect]
(let [parent-rect (:selrect parent)
delta-end (get-delta-end axis parent-rect transformed-parent-rect)]
(if-not (mth/almost-zero? delta-end)
{:displacement (get-displacement axis delta-end)}
{})))
(defmethod constraint-modifier :fixed
[_ axis parent child _ transformed-parent-rect]
(let [parent-rect (:selrect parent)
child-rect (:selrect child)
delta-start (get-delta-start axis parent-rect transformed-parent-rect)
delta-size (get-delta-size axis parent-rect transformed-parent-rect)
child-size (get-size axis child-rect)
child-center (gco/center-rect child-rect)]
(if (or (not (mth/almost-zero? delta-start))
(not (mth/almost-zero? delta-size)))
{:displacement (get-displacement axis delta-start)
:resize-origin (-> (get-displacement axis delta-start (:x1 child-rect) (:y1 child-rect))
(gtr/transform-point-center child-center (:transform child (gmt/matrix))))
:resize-vector (get-scale axis (/ (+ child-size delta-size) child-size))}
{})))
(defmethod constraint-modifier :center
[_ axis parent _ _ transformed-parent-rect]
(let [parent-rect (:selrect parent)
parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (get-delta-center axis parent-center transformed-parent-center)]
(if-not (mth/almost-zero? delta-center)
{:displacement (get-displacement axis delta-center)}
{})))
(defmethod constraint-modifier :scale
[_ axis _ _ modifiers _]
(let [{:keys [resize-vector resize-vector-2 displacement]} modifiers]
(cond-> {}
(and (some? resize-vector)
(not (mth/close? (axis resize-vector) 1)))
(assoc :resize-origin (:resize-origin modifiers)
:resize-vector (if (= :x axis)
(gpt/point (:x resize-vector) 1)
(gpt/point 1 (:y resize-vector))))
(and (= :y axis) (some? resize-vector-2)
(not (mth/close? (:y resize-vector-2) 1)))
(assoc :resize-origin (:resize-origin-2 modifiers)
:resize-vector (gpt/point 1 (:y resize-vector-2)))
(some? displacement)
(assoc :displacement
(get-displacement axis (-> (gpt/point 0 0)
(gpt/transform displacement)
(gpt/transform (:resize-transform-inverse modifiers (gmt/matrix)))
axis))))))
(defmethod constraint-modifier :default [_ _ _ _ _]
{})
(def const->type+axis
{:left :start
:top :start
:right :end
:bottom :end
:leftright :fixed
:topbottom :fixed
:center :center
:scale :scale})
(defn calc-child-modifiers
[parent child modifiers ignore-constraints transformed-parent-rect]
(let [constraints-h
(if-not ignore-constraints
(:constraints-h child (spec/default-constraints-h child))
:scale)
constraints-v
(if-not ignore-constraints
(:constraints-v child (spec/default-constraints-v child))
:scale)
modifiers-h (constraint-modifier (constraints-h const->type+axis) :x parent child modifiers transformed-parent-rect)
modifiers-v (constraint-modifier (constraints-v const->type+axis) :y parent child modifiers transformed-parent-rect)]
;; Build final child modifiers. Apply transform again to the result, to get the
;; real modifiers that need to be applied to the child, including rotation as needed.
(cond-> {}
(or (contains? modifiers-h :displacement)
(contains? modifiers-v :displacement))
(assoc :displacement (cond-> (gpt/point (get-in modifiers-h [:displacement :x] 0)
(get-in modifiers-v [:displacement :y] 0))
(some? (:resize-transform modifiers))
(gpt/transform (:resize-transform modifiers))
:always
(gmt/translate-matrix)))
(:resize-vector modifiers-h)
(assoc :resize-origin (:resize-origin modifiers-h)
:resize-vector (gpt/point (get-in modifiers-h [:resize-vector :x] 1)
(get-in modifiers-h [:resize-vector :y] 1)))
(:resize-vector modifiers-v)
(assoc :resize-origin-2 (:resize-origin modifiers-v)
:resize-vector-2 (gpt/point (get-in modifiers-v [:resize-vector :x] 1)
(get-in modifiers-v [:resize-vector :y] 1)))
(:resize-transform modifiers)
(assoc :resize-transform (:resize-transform modifiers)
:resize-transform-inverse (:resize-transform-inverse modifiers)))))

18
common/src/app/common/geom/shapes/intersect.cljc
View File

@ -147,7 +147,7 @@
(not= wn 0))))
;; A intersects with B
;; Three posible cases:
;; Three possible cases:
;; 1) A is inside of B
;; 2) B is inside of A
;; 3) A intersects B
@ -196,8 +196,8 @@
[point {:keys [cx cy rx ry transform]}]
(let [center (gpt/point cx cy)
transform (gmt/transform-in center transform)
{px :x py :y} (gpt/transform point transform)
transform (when (some? transform) (gmt/transform-in center transform))
{px :x py :y} (if (some? transform) (gpt/transform point transform) point)
;; Ellipse inequality formula
;; https://en.wikipedia.org/wiki/Ellipse#Shifted_ellipse
v (+ (/ (mth/sq (- px cx))
@ -207,11 +207,11 @@
(<= v 1)))
(defn intersects-line-ellipse?
"Checks wether a single line intersects with the given ellipse"
"Checks whether a single line intersects with the given ellipse"
[[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [cx cy rx ry]}]
;; Given the ellipse inequality after inserting the line parametric equations
;; we resolve t and gives us a cuadratic formula
;; we resolve t and gives us a quadratic formula
;; The result of this quadratic will give us a value of T that needs to be
;; between 0-1 to be in the segment
@ -256,10 +256,10 @@
"Checks if a set of lines intersect with an ellipse in any point"
[rect-lines {:keys [cx cy transform] :as ellipse-data}]
(let [center (gpt/point cx cy)
transform (gmt/transform-in center transform)]
transform (when (some? transform) (gmt/transform-in center transform))]
(some (fn [[p1 p2]]
(let [p1 (gpt/transform p1 transform)
p2 (gpt/transform p2 transform)]
(let [p1 (if (some? transform) (gpt/transform p1 transform) p1)
p2 (if (some? transform) (gpt/transform p2 transform) p2)]
(intersects-line-ellipse? [p1 p2] ellipse-data))) rect-lines)))
(defn overlaps-ellipse?
@ -284,7 +284,7 @@
(intersects-lines-ellipse? rect-lines ellipse-data))))
(defn overlaps?
"General case to check for overlaping between shapes and a rectangle"
"General case to check for overlapping between shapes and a rectangle"
[shape rect]
(let [stroke-width (/ (or (:stroke-width shape) 0) 2)
rect (-> rect

153
common/src/app/common/geom/shapes/path.cljc
View File

@ -22,7 +22,7 @@
(mth/almost-zero? (- a b)))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symetric handler"
"Given a point and its handler, gives the symmetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
@ -119,7 +119,9 @@
;; normalize value
d (mth/sqrt (+ (* x x) (* y y)))]
(gpt/point (/ x d) (/ y d))))
(if (mth/almost-zero? d)
(gpt/point 0 0)
(gpt/point (/ x d) (/ y d)))))
(defn curve-windup
[curve t]
@ -179,7 +181,7 @@
(and (mth/almost-zero? d) (mth/almost-zero? a))
[(/ (- c) b)]
;; Cuadratic
;; Quadratic
(mth/almost-zero? d)
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
@ -279,11 +281,19 @@
(filterv #(and (>= % 0) (<= % 1)))))))
(defn command->point
([command] (command->point command nil))
([{params :params} coord]
(let [prefix (if coord (name coord) "")
xkey (keyword (str prefix "x"))
ykey (keyword (str prefix "y"))
([command]
(command->point command nil))
([command coord]
(let [params (:params command)
xkey (case coord
:c1 :c1x
:c2 :c2x
:x)
ykey (case coord
:c1 :c1y
:c2 :c2y
:y)
x (get params xkey)
y (get params ykey)]
(when (and (some? x) (some? y))
@ -322,7 +332,7 @@
(command->point command :c1)
(command->point command :c2)]]
(->> (curve-extremities curve)
(map #(curve-values curve %)))))
(mapv #(curve-values curve %)))))
[])
selrect (gpr/points->selrect points)]
(-> selrect
@ -361,25 +371,25 @@
(update :height #(if (mth/almost-zero? %) 1 %)))))
(defn move-content [content move-vec]
(let [set-tr (fn [params px py]
(let [tr-point (-> (gpt/point (get params px) (get params py))
(gpt/add move-vec))]
(assoc params
px (:x tr-point)
py (:y tr-point))))
(let [dx (:x move-vec)
dy (:y move-vec)
set-tr
(fn [params px py]
(-> params
(update px + dx)
(update py + dy)))
transform-params
(fn [{:keys [x c1x c2x] :as params}]
(cond-> params
(not (nil? x)) (set-tr :x :y)
(not (nil? c1x)) (set-tr :c1x :c1y)
(not (nil? c2x)) (set-tr :c2x :c2y)))]
(some? x) (set-tr :x :y)
(some? c1x) (set-tr :c1x :c1y)
(some? c2x) (set-tr :c2x :c2y)))]
(->> content
(mapv (fn [cmd]
(cond-> cmd
(map? cmd)
(update :params transform-params)))))))
(into []
(map #(update % :params transform-params))
content)))
(defn transform-content
[content transform]
@ -393,11 +403,13 @@
transform-params
(fn [{:keys [x c1x c2x] :as params}]
(cond-> params
(not (nil? x)) (set-tr :x :y)
(not (nil? c1x)) (set-tr :c1x :c1y)
(not (nil? c2x)) (set-tr :c2x :c2y)))]
(some? x) (set-tr :x :y)
(some? c1x) (set-tr :c1x :c1y)
(some? c2x) (set-tr :c2x :c2y)))]
(mapv #(update % :params transform-params) content)))
(into []
(map #(update % :params transform-params))
content)))
(defn segments->content
([segments]
@ -675,12 +687,10 @@
(curve-roots c2' :y)))
(defn ray-line-intersect
[point [a b :as line]]
;; If the ray is paralell to the line there will be no crossings
;; If the ray is parallel to the line there will be no crossings
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
;; Rays fail when fall just in a vertex so we move a bit upward
;; because only want to use this for insideness
@ -707,20 +717,19 @@
[[l1-t] [l2-t]])))
(defn ray-curve-intersect
[ray-line c2]
[ray-line curve]
(let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))]
curve-ts (->> (line-curve-crossing ray-line c2)
(filterv #(let [curve-v (curve-values c2 %)
curve-tg (curve-tangent c2 %)
(let [curve-ts (->> (line-curve-crossing ray-line curve)
(filterv #(let [curve-v (curve-values curve %)
curve-tg (curve-tangent curve %)
curve-tg-angle (gpt/angle curve-tg)
ray-t (get-line-tval ray-line curve-v)]
(and (> ray-t 0)
(> (mth/abs (- curve-tg-angle 180)) 0.01)
(> (mth/abs (- curve-tg-angle 0)) 0.01)) )))]
(->> curve-ts
(mapv #(vector (curve-values c2 %)
(curve-windup c2 %))))))
(mapv #(vector (curve-values curve %)
(curve-windup curve %))))))
(defn line-curve-intersect
[l1 c2]
@ -816,32 +825,58 @@
(->> content
(some inside-border?))))
(defn is-point-in-content?
[point content]
(let [selrect (content->selrect content)
ray-line [point (gpt/point (inc (:x point)) (:y point))]
(defn close-content
[content]
(into []
(comp (filter sp/is-closed?)
(mapcat :data))
(->> content
(sp/close-subpaths)
(sp/get-subpaths))))
closed-content
(into []
(comp (filter sp/is-closed?)
(mapcat :data))
(->> content
(sp/close-subpaths)
(sp/get-subpaths)))
(defn ray-overlaps?
[ray-point {selrect :selrect}]
(and (>= (:y ray-point) (:y1 selrect))
(<= (:y ray-point) (:y2 selrect))))
(defn content->geom-data
[content]
(->> content
(close-content)
(filter #(not= (= :line-to (:command %))
(= :curve-to (:command %))))
(mapv (fn [segment]
{:command (:command segment)
:segment segment
:geom (if (= :line-to (:command segment))
(command->line segment)
(command->bezier segment))
:selrect (command->selrect segment)}))))
(defn is-point-in-geom-data?
[point content-geom]
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
cast-ray
(fn [cmd]
(case (:command cmd)
:line-to (ray-line-intersect point (command->line cmd))
:curve-to (ray-curve-intersect ray-line (command->bezier cmd))
#_:else []))]
(fn [data]
(case (:command data)
:line-to
(ray-line-intersect point (:geom data))
(and (gpr/contains-point? selrect point)
(->> closed-content
(mapcat cast-ray)
(map second)
(reduce +)
(not= 0)))))
:curve-to
(ray-curve-intersect ray-line (:geom data))
#_:default []))]
(->> content-geom
(filter (partial ray-overlaps? point))
(mapcat cast-ray)
(map second)
(reduce +)
(not= 0))))
(defn split-line-to
"Given a point and a line-to command will create a two new line-to commands

16
common/src/app/common/geom/shapes/rect.cljc
View File

@ -121,3 +121,19 @@
(or (< px x2) (s= px x2))
(or (> py y1) (s= py y1))
(or (< py y2) (s= py y2)))))
(defn contains-selrect?
"Check if a selrect sr2 is contained inside sr1"
[sr1 sr2]
(and (>= (:x1 sr2) (:x1 sr1))
(<= (:x2 sr2) (:x2 sr1))
(>= (:y1 sr2) (:y1 sr1))
(<= (:y2 sr2) (:y2 sr1))))
(defn round-selrect
[selrect]
(-> selrect
(update :x mth/round)
(update :y mth/round)
(update :width mth/round)
(update :height mth/round)))

478
common/src/app/common/geom/shapes/transforms.cljc
View File

@ -14,31 +14,37 @@
[app.common.geom.shapes.path :as gpa]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.text :as txt]))
(def ^:dynamic *skip-adjust* false)
;; --- Relative Movement
(defn- move-selrect [selrect {dx :x dy :y}]
(-> selrect
(d/update-when :x + dx)
(d/update-when :y + dy)
(d/update-when :x1 + dx)
(d/update-when :y1 + dy)
(d/update-when :x2 + dx)
(d/update-when :y2 + dy)))
(defn- move-selrect [selrect pt]
(when (and (some? selrect) (some? pt))
(let [dx (.-x pt)
dy (.-y pt)
{:keys [x y x1 y1 x2 y2 width height]} selrect]
{:x (if (some? x) (+ dx x) x)
:y (if (some? y) (+ dy y) y)
:x1 (if (some? x1) (+ dx x1) x1)
:y1 (if (some? y1) (+ dy y1) y1)
:x2 (if (some? x2) (+ dx x2) x2)
:y2 (if (some? y2) (+ dy y2) y2)
:width width
:height height})))
(defn- move-points [points move-vec]
(->> points
(mapv #(gpt/add % move-vec))))
(defn move
"Move the shape relativelly to its current
"Move the shape relatively to its current
position applying the provided delta."
[shape {dx :x dy :y}]
(let [dx (d/check-num dx)
dy (d/check-num dy)
[{:keys [type] :as shape} {dx :x dy :y}]
(let [dx (d/check-num dx)
dy (d/check-num dy)
move-vec (gpt/point dx dy)]
(-> shape
@ -46,9 +52,8 @@
(update :points move-points move-vec)
(d/update-when :x + dx)
(d/update-when :y + dy)
(cond-> (= :path (:type shape))
(update :content gpa/move-content move-vec)))))
(cond-> (= :bool type) (update :bool-content gpa/move-content move-vec))
(cond-> (= :path type) (update :content gpa/move-content move-vec)))))
;; --- Absolute Movement
@ -71,7 +76,7 @@
:else scale))
(defn- calculate-skew-angle
"Calculates the skew angle of the paralelogram given by the points"
"Calculates the skew angle of the parallelogram given by the points"
[[p1 _ p3 p4]]
(let [v1 (gpt/to-vec p3 p4)
v2 (gpt/to-vec p4 p1)]
@ -83,13 +88,13 @@
(- 90 (gpt/angle-with-other v1 v2)))))
(defn- calculate-height
"Calculates the height of a paralelogram given by the points"
"Calculates the height of a parallelogram given by the points"
[[p1 _ _ p4]]
(-> (gpt/to-vec p4 p1)
(gpt/length)))
(defn- calculate-width
"Calculates the width of a paralelogram given by the points"
"Calculates the width of a parallelogram given by the points"
[[p1 p2 _ _]]
(-> (gpt/to-vec p1 p2)
(gpt/length)))
@ -154,11 +159,12 @@
(defn transform-point-center
"Transform a point around the shape center"
[point center matrix]
(gpt/transform
point
(gmt/multiply (gmt/translate-matrix center)
matrix
(gmt/translate-matrix (gpt/negate center)))))
(when point
(gpt/transform
point
(gmt/multiply (gmt/translate-matrix center)
matrix
(gmt/translate-matrix (gpt/negate center))))))
(defn transform-rect
"Transform a rectangles and changes its attributes"
@ -170,9 +176,11 @@
(defn calculate-adjust-matrix
"Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
after applying them the end result is the `shape-pathn-temp`.
after applying them the end result is the `shape-path-temp`.
This is compose of three transformations: skew, resize and rotation"
([points-temp points-rec] (calculate-adjust-matrix points-temp points-rec false false))
([points-temp points-rec]
(calculate-adjust-matrix points-temp points-rec false false))
([points-temp points-rec flip-x flip-y]
(let [center (gco/center-points points-temp)
@ -210,63 +218,78 @@
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
;; This is the inverse to be able to remove the transformation
stretch-matrix-inverse (-> (gmt/matrix)
(gmt/scale (gpt/point (/ 1 w3) (/ 1 h3)))
(gmt/skew (- skew-angle) 0)
(gmt/rotate (- rotation-angle)))]
stretch-matrix-inverse
(gmt/multiply (gmt/scale-matrix (gpt/point (/ 1 w3) (/ 1 h3)))
(gmt/skew-matrix (- skew-angle) 0)
(gmt/rotate-matrix (- rotation-angle)))]
[stretch-matrix stretch-matrix-inverse rotation-angle])))
(defn- apply-transform
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?]
(let [points (-> shape :points (gco/transform-points transform))
center (gco/center-points points)
(defn is-rotated?
[[a b _c _d]]
;; true if either a-b or c-d are parallel to the axis
(not (mth/close? (:y a) (:y b))))
;; Reverse the current transformation stack to get the base rectangle
tr-inverse (:transform-inverse shape (gmt/matrix))
(defn- adjust-rotated-transform
[{:keys [transform transform-inverse flip-x flip-y]} points]
(let [center (gco/center-points points)
points-temp (gco/transform-points points center tr-inverse)
points-temp (cond-> points
(some? transform-inverse)
(gco/transform-points center transform-inverse))
points-temp-dim (calculate-dimensions points-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
;; to have this width, height, x, y
rect-shape (-> (gco/make-centered-rect
center
(:width points-temp-dim)
(:height points-temp-dim))
(update :width max 1)
(update :height max 1))
new-width (max 1 (:width points-temp-dim))
new-height (max 1 (:height points-temp-dim))
selrect (gco/make-centered-selrect center new-width new-height)
rect-points (gpr/rect->points rect-shape)
rect-points (gpr/rect->points selrect)
[matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points flip-x flip-y)]
[matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
[selrect
(if transform (gmt/multiply transform matrix) matrix)
(if transform-inverse (gmt/multiply matrix-inverse transform-inverse) matrix-inverse)]))
rect-shape (cond-> rect-shape
round-coords?
(-> (update :x mth/round)
(update :y mth/round)
(update :width mth/round)
(update :height mth/round)))
(defn- apply-transform
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform-mtx round-coords?]
shape (cond
(= :path (:type shape))
(-> shape
(update :content #(gpa/transform-content % transform)))
(let [points' (:points shape)
points (gco/transform-points points' transform-mtx)
bool? (= (:type shape) :bool)
path? (= (:type shape) :path)
rotated? (is-rotated? points)
:else
(-> shape
(merge rect-shape)))
[selrect transform transform-inverse]
(if (not rotated?)
[(gpr/points->selrect points) nil nil]
(adjust-rotated-transform shape points))
selrect (cond-> selrect
round-coords? gpr/round-selrect)
;; Redondear los points?
base-rotation (or (:rotation shape) 0)
modif-rotation (or (get-in shape [:modifiers :rotation]) 0)]
modif-rotation (or (get-in shape [:modifiers :rotation]) 0)
rotation (mod (+ base-rotation modif-rotation) 360)]
(as-> shape $
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
(update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
(assoc $ :points (into [] points))
(assoc $ :selrect (gpr/rect->selrect rect-shape))
(assoc $ :rotation (mod (+ base-rotation modif-rotation) 360)))))
(-> shape
(cond-> bool?
(update :bool-content gpa/transform-content transform-mtx))
(cond-> path?
(update :content gpa/transform-content transform-mtx))
(cond-> (not path?)
(-> (merge (select-keys selrect [:x :y :width :height]))))
(cond-> transform
(-> (assoc :transform transform)
(assoc :transform-inverse transform-inverse)))
(cond-> (not transform)
(dissoc :transform :transform-inverse))
(assoc :selrect selrect)
(assoc :points points)
(assoc :rotation rotation))))
(defn- update-group-viewbox
"Updates the viewbox for groups imported from SVG's"
@ -299,7 +322,7 @@
(gpr/rect->points)
(gco/transform-points shape-center (:transform group (gmt/matrix))))
;; Calculte the new selrect
;; Calculate the new selrect
new-selrect (gpr/points->selrect base-points)]
;; Updates the shape and the applytransform-rect will update the other properties
@ -342,6 +365,9 @@
;; tells if the resize vectors must be applied to text shapes
;; or not.
(defn empty-modifiers? [modifiers]
(empty? (dissoc modifiers :ignore-geometry?)))
(defn resize-modifiers
[shape attr value]
(us/assert map? shape)
@ -395,53 +421,54 @@
(->> modifiers
(reduce set-modifier objects))))
(defn- modifiers->transform
[center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
{res-x-2 :x res-y-2 :y} (:resize-vector-2 modifiers (gpt/point 1 1))
(defn modifiers->transform
([modifiers]
(modifiers->transform nil modifiers))
;; Normalize x/y vector coordinates because scale by 0 is infinite
res-x (normalize-scale res-x)
res-y (normalize-scale res-y)
resize (gpt/point res-x res-y)
([center modifiers]
(let [displacement (:displacement modifiers)
resize-v1 (:resize-vector modifiers)
resize-v2 (:resize-vector-2 modifiers)
origin-1 (:resize-origin modifiers (gpt/point))
origin-2 (:resize-origin-2 modifiers (gpt/point))
res-x-2 (normalize-scale res-x-2)
res-y-2 (normalize-scale res-y-2)
resize-2 (gpt/point res-x-2 res-y-2)
;; Normalize x/y vector coordinates because scale by 0 is infinite
resize-1 (when (some? resize-v1)
(gpt/point (normalize-scale (:x resize-v1))
(normalize-scale (:y resize-v1))))
origin (:resize-origin modifiers (gpt/point 0 0))
origin-2 (:resize-origin-2 modifiers (gpt/point 0 0))
resize-2 (when (some? resize-v2)
(gpt/point (normalize-scale (:x resize-v2))
(normalize-scale (:y resize-v2))))
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0)
center (gpt/transform center ds-modifier)
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
transform (-> (gmt/matrix)
rt-modif (:rotation modifiers)]
;; Applies the current resize transformation
(gmt/translate origin)
(gmt/multiply resize-transform)
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
(cond-> (gmt/matrix)
(some? resize-1)
(-> (gmt/translate origin-1)
(gmt/multiply resize-transform)
(gmt/scale resize-1)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin-1)))
(gmt/translate origin-2)
(gmt/multiply resize-transform)
(gmt/scale resize-2)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin-2))
(some? resize-2)
(-> (gmt/translate origin-2)
(gmt/multiply resize-transform)
(gmt/scale resize-2)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin-2)))
;; Applies the stacked transformations
(gmt/translate center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/translate (gpt/negate center))
(some? displacement)
(gmt/multiply displacement)
;; Displacement
(gmt/multiply ds-modifier))]
transform))
(some? rt-modif)
(-> (gmt/translate center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/translate (gpt/negate center)))))))
(defn- set-flip [shape modifiers]
(let [rx (or (get-in modifiers [:resize-vector :x])
@ -463,7 +490,7 @@
modifiers (dissoc modifiers :displacement)]
(-> shape
(assoc :modifiers modifiers)
(cond-> (empty? modifiers)
(cond-> (empty-modifiers? modifiers)
(dissoc :modifiers))))
shape)))
@ -485,205 +512,77 @@
%)))
shape))
(defn apply-modifiers
[shape modifiers round-coords?]
(let [center (gco/center-shape shape)
transform (modifiers->transform center modifiers)]
(apply-transform shape transform round-coords?)))
(defn transform-shape
([shape]
(transform-shape shape nil))
([shape {:keys [round-coords?]
:or {round-coords? true}}]
(let [shape (apply-displacement shape)
center (gco/center-shape shape)
modifiers (:modifiers shape)]
(if (and modifiers center)
(let [transform (modifiers->transform center modifiers)]
(-> shape
(set-flip modifiers)
(apply-transform transform round-coords?)
(apply-text-resize modifiers)
(dissoc :modifiers)))
shape))))
([shape {:keys [round-coords?] :or {round-coords? true}}]
(let [modifiers (:modifiers shape)]
(cond
(nil? modifiers)
shape
(defn calc-child-modifiers
"Given the modifiers to apply to the parent, calculate the corresponding
modifiers for the child, depending on the child constraints."
[parent child parent-modifiers ignore-constraints]
(let [parent-rect (:selrect parent)
child-rect (:selrect child)
(empty-modifiers? modifiers)
(dissoc shape :modifiers)
;; Apply the modifiers to the parent's selrect, to check the difference with
;; the original, and calculate child transformations from this.
;;
;; Note that a shape's selrect is always "horizontal" (i.e. without applying
;; the shape transform, that may include some rotation and skew). Thus, to
;; apply the modifiers, we first apply to them the transform-inverse.
parent-displacement (-> (gpt/point 0 0)
(gpt/transform (get parent-modifiers :displacement (gmt/matrix)))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(gmt/translate-matrix))
parent-origin (-> (:resize-origin parent-modifiers)
((d/nilf transform-point-center)
(gco/center-shape parent)
(:resize-transform-inverse parent-modifiers (gmt/matrix))))
parent-origin-2 (-> (:resize-origin-2 parent-modifiers)
((d/nilf transform-point-center)
(gco/center-shape parent)
(:resize-transform-inverse parent-modifiers (gmt/matrix))))
parent-vector (get parent-modifiers :resize-vector (gpt/point 1 1))
parent-vector-2 (get parent-modifiers :resize-vector-2 (gpt/point 1 1))
:else
(let [shape (apply-displacement shape)
modifiers (:modifiers shape)]
(cond-> shape
(not (empty-modifiers? modifiers))
(-> (set-flip modifiers)
(apply-modifiers modifiers round-coords?)
(apply-text-resize modifiers))
transformed-parent-rect (-> parent-rect
(gpr/rect->points)
(gco/transform-points parent-displacement)
(gco/transform-points parent-origin (gmt/scale-matrix parent-vector))
(gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
(gpr/points->selrect))
:always
(dissoc :modifiers)))))))
;; Calculate the modifiers in the horizontal and vertical directions
;; depending on the child constraints.
constraints-h (if-not ignore-constraints
(get child :constraints-h (spec/default-constraints-h child))
:scale)
constraints-v (if-not ignore-constraints
(get child :constraints-v (spec/default-constraints-v child))
:scale)
(defn transform-selrect
[selrect {:keys [displacement resize-transform-inverse resize-vector resize-origin resize-vector-2 resize-origin-2]}]
;; FIXME: Improve Performance
(let [resize-transform-inverse (or resize-transform-inverse (gmt/matrix))
modifiers-h (case constraints-h
:left
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))]
displacement
(when (some? displacement)
(gmt/multiply resize-transform-inverse displacement)
#_(-> (gpt/point 0 0)
(gpt/transform displacement)
(gpt/transform resize-transform-inverse)
(gmt/translate-matrix)))
(if-not (mth/almost-zero? delta-left)
{:displacement (gpt/point delta-left 0)} ;; we convert to matrix below
{}))
resize-origin
(when (some? resize-origin)
(transform-point-center resize-origin (gco/center-selrect selrect) resize-transform-inverse))
:right
(let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))]
(if-not (mth/almost-zero? delta-right)
{:displacement (gpt/point delta-right 0)}
{}))
resize-origin-2
(when (some? resize-origin-2)
(transform-point-center resize-origin-2 (gco/center-selrect selrect) resize-transform-inverse))]
:leftright
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))
delta-width (- (:width transformed-parent-rect) (:width parent-rect))]
(if (or (not (mth/almost-zero? delta-left))
(not (mth/almost-zero? delta-width)))
{:displacement (gpt/point delta-left 0)
:resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left)
(:y1 child-rect))
(transform-point-center
(gco/center-rect child-rect)
(:transform child (gmt/matrix))))
:resize-vector (gpt/point (/ (+ (:width child-rect) delta-width)
(:width child-rect)) 1)}
{}))
(if (and (nil? displacement) (nil? resize-origin) (nil? resize-origin-2))
selrect
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:x transformed-parent-center) (:x parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point delta-center 0)}
{}))
(cond-> selrect
:always
(gpr/rect->points)
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:x (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
(some? displacement)
(gco/transform-points displacement)
;; resize-vector-2 is always for vertical modifiers, so no need to
;; check it here.
(some? resize-origin)
(gco/transform-points resize-origin (gmt/scale-matrix resize-vector))
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:x))
0)))
{})
(some? resize-origin-2)
(gco/transform-points resize-origin-2 (gmt/scale-matrix resize-vector-2))
modifiers-v (case constraints-v
:top
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))]
(if-not (mth/almost-zero? delta-top)
{:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below
{}))
:bottom
(let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))]
(if-not (mth/almost-zero? delta-bottom)
{:displacement (gpt/point 0 delta-bottom)}
{}))
:topbottom
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))
delta-height (- (:height transformed-parent-rect) (:height parent-rect))]
(if (or (not (mth/almost-zero? delta-top))
(not (mth/almost-zero? delta-height)))
{:displacement (gpt/point 0 delta-top)
:resize-origin (-> (gpt/point (:x1 child-rect)
(+ (:y1 child-rect) delta-top))
(transform-point-center
(gco/center-rect child-rect)
(:transform child (gmt/matrix))))
:resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height)
(:height child-rect)))}
{}))
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:y transformed-parent-center) (:y parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point 0 delta-center)}
{}))
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:y (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers))))
;; If there is a resize-vector-2, this means that we come from a recursive
;; call, and the resize-vector has no vertical data, so we may override it.
(and (:resize-vector-2 parent-modifiers)
(not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin-2 parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point 0 (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:y)))))
{})]
;; Build final child modifiers. Apply transform again to the result, to get the
;; real modifiers that need to be applied to the child, including rotation as needed.
(cond-> {}
(or (:displacement modifiers-h) (:displacement modifiers-v))
(assoc :displacement (gmt/translate-matrix
(-> (gpt/point (get (:displacement modifiers-h) :x 0)
(get (:displacement modifiers-v) :y 0))
(gpt/transform
(:resize-transform parent-modifiers (gmt/matrix))))))
(:resize-vector modifiers-h)
(assoc :resize-origin (:resize-origin modifiers-h)
:resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1)
(get (:resize-vector modifiers-h) :y 1)))
(:resize-vector modifiers-v)
(assoc :resize-origin-2 (:resize-origin modifiers-v)
:resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1)
(get (:resize-vector modifiers-v) :y 1)))
(:resize-transform parent-modifiers)
(assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers)))))
:always
(gpr/points->selrect)))))
(defn selection-rect
@ -691,6 +590,5 @@
rotation of each shape. Mainly used for multiple selection."
[shapes]
(->> shapes
(transform-shape)
(map (comp gpr/points->selrect :points))
(map (comp gpr/points->selrect :points transform-shape))
(gpr/join-selrects)))

27
common/src/app/common/logging.cljc
View File

@ -168,21 +168,22 @@
`(write-log! ~(or logger (str *ns*))
~level
~cause
~(dissoc props :level :cause ::logger ::raw))
(or ~raw ~(dissoc props :level :cause ::logger ::raw)))
(let [props (dissoc props :level :cause ::logger ::async ::raw)
logger (or logger (str *ns*))
logger-sym (gensym "log")
level-sym (gensym "log")]
`(let [~logger-sym (get-logger ~logger)
~level-sym (get-level ~level)]
(if (enabled? ~logger-sym ~level-sym)
(when (enabled? ~logger-sym ~level-sym)
~(if async
`(let [cdata# (ThreadContext/getImmutableContext)]
(send-off logging-agent
(fn [_#]
(with-context (into {:cause ~cause} cdata#)
(->> (or ~raw (build-map-message ~props))
(write-log! ~logger-sym ~level-sym ~cause))))))
`(->> (ThreadContext/getImmutableContext)
(send-off logging-agent
(fn [_# cdata#]
(with-context (into {} cdata#)
(->> (or ~raw (build-map-message ~props))
(write-log! ~logger-sym ~level-sym ~cause))))))
`(let [message# (or ~raw (build-map-message ~props))]
(write-log! ~logger-sym ~level-sym ~cause message#))))))))
@ -297,7 +298,7 @@
#?(:cljs
(defn default-handler
[{:keys [message level logger-name]}]
[{:keys [message level logger-name exception] :as params}]
(let [header-styles (str "font-weight: 600; color: " (level->color level))
normal-styles (str "font-weight: 300; color: " (get colors :gray6))
level-name (level->short-name level)
@ -318,7 +319,13 @@
(js/console.error v))))
(js/console.groupEnd message))
(let [message (str header "%c" (pr-str message))]
(js/console.log message header-styles normal-styles))))))))
(js/console.log message header-styles normal-styles)))))
(when exception
(when-let [data (ex-data exception)]
(js/console.error "cause data:" (pr-str data)))
(js/console.error (.-stack exception))))))
#?(:cljs
(defn record->map

2
common/src/app/common/media.cljc
View File

@ -78,7 +78,7 @@
(re-seq #"(?i)(?:extra\s*bold|ultra\s*bold)" variant) 800
(re-seq #"(?i)(?:bold)" variant) 700
(re-seq #"(?i)(?:extra\s*black|ultra\s*black)" variant) 950
(re-seq #"(?i)(?:black|heavy)" variant) 900
(re-seq #"(?i)(?:black|heavy|solid)" variant) 900
:else 400))
(defn parse-font-style

2
common/src/app/common/pages.cljc
View File

@ -69,6 +69,7 @@
(d/export helpers/compact-path)
(d/export helpers/compact-name)
(d/export helpers/unframed-shape?)
(d/export helpers/children-seq)
;; Indices
(d/export indices/calculate-z-index)
@ -94,7 +95,6 @@
(s/def ::color ::spec/color)
(s/def ::data ::spec/data)
(s/def ::media-object ::spec/media-object)
(s/def ::minimal-shape ::spec/minimal-shape)
(s/def ::page ::spec/page)
(s/def ::recent-color ::spec/recent-color)
(s/def ::shape-attrs ::spec/shape-attrs)

49
common/src/app/common/pages/changes.cljc
View File

@ -40,7 +40,9 @@
(defmulti process-operation (fn [_ op] (:type op)))
(defn process-changes
([data items] (process-changes data items true))
([data items]
(process-changes data items true))
([data items verify?]
;; When verify? false we spec the schema validation. Currently used to make just
;; 1 validation even if the changes are applied twice
@ -152,29 +154,37 @@
;; reg-objects operation "regenerates" the geometry and selrect of the parent groups
(defmethod process-change :reg-objects
[data {:keys [page-id component-id shapes]}]
;; FIXME: Improve performance
(letfn [(reg-objects [objects]
(reduce #(d/update-when %1 %2 update-group %1) objects
(sequence (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map #(get objects %))
(filter #(contains? #{:group :bool} (:type %)))
(map :id)
(distinct))
shapes)))
(let [lookup (d/getf objects)
update-fn #(d/update-when %1 %2 update-group %1)
xform (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map lookup)
(filter #(contains? #{:group :bool} (:type %)))
(map :id)
(distinct))]
(->> (sequence xform shapes)
(reduce update-fn objects))))
(set-mask-selrect [group children]
(let [mask (first children)]
(-> group
(merge (select-keys mask [:selrect :points]))
(assoc :x (-> mask :selrect :x)
:y (-> mask :selrect :y)
:width (-> mask :selrect :width)
:height (-> mask :selrect :height)
:flip-x (-> mask :flip-x)
:flip-y (-> mask :flip-y)))))
(assoc :selrect (-> mask :selrect))
(assoc :points (-> mask :points))
(assoc :x (-> mask :selrect :x))
(assoc :y (-> mask :selrect :y))
(assoc :width (-> mask :selrect :width))
(assoc :height (-> mask :selrect :height))
(assoc :flip-x (-> mask :flip-x))
(assoc :flip-y (-> mask :flip-y)))))
(update-group [group objects]
(let [children (->> group :shapes (map #(get objects %)))]
(let [lookup (d/getf objects)
children (->> group :shapes (map lookup))]
(cond
;; If the group is empty we don't make any changes. Should be removed by a later process
;; If the group is empty we don't make any changes. Will be removed by a later process
(empty? children)
group
@ -292,7 +302,7 @@
(reduce update-parent-id $ shapes)
;; Analyze the old parents and clear the old links
;; only if the new parrent is different form old
;; only if the new parent is different form old
;; parent.
(reduce (partial remove-from-old-parent cpindex) $ shapes)
@ -470,4 +480,3 @@
(ex/raise :type :not-implemented
:code :operation-not-implemented
:context {:type (:type op)}))

55
common/src/app/common/pages/changes_builder.cljc
View File

@ -12,7 +12,8 @@
;; Auxiliary functions to help create a set of changes (undo + redo)
(defn empty-changes [origin page-id]
(defn empty-changes
[origin page-id]
(let [changes {:redo-changes []
:undo-changes []
:origin origin}]
@ -46,29 +47,33 @@
(update :undo-changes d/preconj del-change)))))
(defn change-parent
[changes parent-id shapes]
(assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
([changes parent-id shapes] (change-parent changes parent-id shapes nil))
([changes parent-id shapes index]
(assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
(let [objects (::objects (meta changes))
set-parent-change
{:type :mov-objects
:parent-id parent-id
:page-id (::page-id (meta changes))
:shapes (->> shapes (mapv :id))}
(let [objects (::objects (meta changes))
set-parent-change
(cond-> {:type :mov-objects
:parent-id parent-id
:page-id (::page-id (meta changes))
:shapes (->> shapes (mapv :id))}
mk-undo-change
(fn [change-set shape]
(d/preconj
change-set
{:type :mov-objects
:page-id (::page-id (meta changes))
:parent-id (:parent-id shape)
:shapes [(:id shape)]
:index (cp/position-on-parent (:id shape) objects)}))]
(some? index)
(assoc :index index))
(-> changes
(update :redo-changes conj set-parent-change)
(update :undo-changes #(reduce mk-undo-change % shapes)))))
mk-undo-change
(fn [change-set shape]
(d/preconj
change-set
{:type :mov-objects
:page-id (::page-id (meta changes))
:parent-id (:parent-id shape)
:shapes [(:id shape)]
:index (cp/position-on-parent (:id shape) objects)}))]
(-> changes
(update :redo-changes conj set-parent-change)
(update :undo-changes #(reduce mk-undo-change % shapes))))))
(defn- generate-operation
"Given an object old and new versions and an attribute will append into changes
@ -165,3 +170,11 @@
(update :undo-changes #(as-> % $
(reduce add-undo-change-parent $ ids)
(reduce add-undo-change-shape $ ids))))))
(defn move-page
[chdata index prev-index]
(let [page-id (::page-id (meta chdata))]
(-> chdata
(update :redo-changes conj {:type :mov-page :id page-id :index index})
(update :undo-changes conj {:type :mov-page :id page-id :index prev-index}))))

4
common/src/app/common/pages/common.cljc
View File

@ -6,10 +6,11 @@
(ns app.common.pages.common
(:require
[app.common.colors :as clr]
[app.common.uuid :as uuid]))
(def file-version 12)
(def default-color "#b1b2b5") ;; $color-gray-20
(def default-color clr/gray-20)
(def root uuid/zero)
(def component-sync-attrs
@ -19,6 +20,7 @@
:fill-color-gradient :fill-group
:fill-color-ref-file :fill-group
:fill-color-ref-id :fill-group
:hide-fill-on-export :fill-group
:content :content-group
:hidden :visibility-group
:blocked :modifiable-group

56
common/src/app/common/pages/helpers.cljc
View File

@ -46,13 +46,14 @@
(defn get-root-shape
"Get the root shape linked to a component for this shape, if any"
[shape objects]
(if-not (:shape-ref shape)
nil
(if (:component-root? shape)
shape
(if-let [parent-id (:parent-id shape)]
(get-root-shape (get objects parent-id) objects)
nil))))
(cond
(some? (:component-root? shape))
shape
(some? (:shape-ref shape))
(recur (get objects (:parent-id shape))
objects)))
(defn make-container
[page-or-component type]
@ -98,35 +99,10 @@
[component]
(get-in component [:objects (:id component)]))
;; Implemented with transient for performance
(defn get-children
"Retrieve all children ids recursively for a given object. The
children's order will be breadth first."
[id objects]
(loop [result (transient [])
pending (transient [])
next id]
(let [children (get-in objects [next :shapes] [])
[result pending]
;; Iterate through children and add them to the result
;; also add them in pending to check for their children
(loop [result result
pending pending
current (first children)
children (rest children)]
(if current
(recur (conj! result current)
(conj! pending current)
(first children)
(rest children))
[result pending]))
;; If we have still pending, advance the iterator
length (count pending)]
(if (pos? length)
(let [next (get pending (dec length))]
(recur result (pop! pending) next))
(persistent! result)))))
(defn get-children [id objects]
(if-let [shapes (-> (get objects id) :shapes (some-> vec))]
(into shapes (mapcat #(get-children % objects)) shapes)
[]))
(defn get-children-objects
"Retrieve all children objects recursively for a given object"
@ -175,6 +151,7 @@
(defn clean-loops
"Clean a list of ids from circular references."
[objects ids]
(let [parent-selected?
(fn [id]
(let [parents (get-parents id objects)]
@ -481,3 +458,10 @@
(and (not= (:type shape) :frame)
(= (:frame-id shape) uuid/zero)))
(defn children-seq
"Creates a sequence of shapes through the objects tree"
[shape objects]
(let [getter (partial get objects)]
(tree-seq #(d/not-empty? (get shape :shapes))
#(->> (get % :shapes) (map getter))
shape)))

16
common/src/app/common/pages/init.cljc
View File

@ -6,6 +6,7 @@
(ns app.common.pages.init
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages.common :refer [file-version default-color]]
@ -32,9 +33,10 @@
(def default-frame-attrs
{:frame-id uuid/zero
:fill-color "#ffffff"
:fill-color clr/white
:fill-opacity 1
:shapes []})
:shapes []
:hide-fill-on-export false})
(def ^:private minimal-shapes
[{:type :rect
@ -44,7 +46,7 @@
:stroke-style :none
:stroke-alignment :center
:stroke-width 0
:stroke-color "#000000"
:stroke-color clr/black
:stroke-opacity 0
:rx 0
:ry 0}
@ -58,7 +60,7 @@
:stroke-style :none
:stroke-alignment :center
:stroke-width 0
:stroke-color "#000000"
:stroke-color clr/black
:stroke-opacity 0}
{:type :path
@ -66,17 +68,17 @@
:stroke-style :solid
:stroke-alignment :center
:stroke-width 2
:stroke-color "#000000"
:stroke-color clr/black
:stroke-opacity 1}
{:type :frame
:name "Artboard-1"
:fill-color "#ffffff"
:fill-color clr/white
:fill-opacity 1
:stroke-style :none
:stroke-alignment :center
:stroke-width 0
:stroke-color "#000000"
:stroke-color clr/black
:stroke-opacity 0}
{:type :text

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