Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-13 16:21:57 -05:00
Code Issues Activity

Merge branch 'staging' into main

Browse source
This commit is contained in:
Andrey Antukh 2021-04-07 13:19:07 +02:00
commit e8aa521a1e
471 changed files with 13851 additions and 34670 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
.gitignore vendored
View file

@ -15,6 +15,7 @@ node_modules
/backend/target/
/backend/resources/public/media
/backend/resources/public/assets
/backend/assets/
/backend/dist/
/backend/logs/
/backend/-
@ -26,7 +27,7 @@ node_modules
/frontend/resources/public/*
/exporter/target
/exporter/.shadow-cljs
/docker/images/bundle
/docker/images/bundle*
/.clj-kondo/.cache
/bundle*
/media

92
CHANGES.md
View file

@ -6,9 +6,85 @@
### :bug: Bugs fixed
### :arrow_up: Deps updates
### :heart: Community contributions by (Thank you!)
## 1.4.0-alpha
### :sparkles: New features
- Add blob-encoding v3 (uses ZSTD+transit) [#738](https://github.com/penpot/penpot/pull/738)
- 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 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)
- Duplicate and move files and projects [Taiga #267](https://tree.taiga.io/project/penpot/us/267)
- 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).
- 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)
- Fix broken profile and profile options form.
- Fix calculate size of some animated gifs [Taiga #1487](https://tree.taiga.io/project/penpot/issue/1487)
- Fix error with the "Navigate to" button on prototypes [Taiga #1268](https://tree.taiga.io/project/penpot/issue/1268)
- Fix issue when undo after changing the artboard of a shape [Taiga #1304](https://tree.taiga.io/project/penpot/issue/1304)
- Fix issue with Alt key in distance measurement [#672](https://github.com/penpot/penpot/issues/672)
- Fix issue with blending modes in masks [Taiga #1476](https://tree.taiga.io/project/penpot/issue/1476)
- Fix issue with blocked shapes [Taiga #1480](https://tree.taiga.io/project/penpot/issue/1480)
- Fix issue with comments styles on dashboard [Taiga #1405](https://tree.taiga.io/project/penpot/issue/1405)
- Fix issue with default square grid [Taiga #1344](https://tree.taiga.io/project/penpot/issue/1344)
- Fix issue with enter key shortcut [#775](https://github.com/penpot/penpot/issues/775)
- Fix issue with enter to edit paths [Taiga #1481](https://tree.taiga.io/project/penpot/issue/1481)
- Fix issue with mask and flip [#715](https://github.com/penpot/penpot/issues/715)
- Fix issue with masks interactions outside bounds [#718](https://github.com/penpot/penpot/issues/718)
- Fix issue with middle mouse button press moving the canvas when not moving mouse [#717](https://github.com/penpot/penpot/issues/717)
- Fix issue with resolved comments [Taiga #1406](https://tree.taiga.io/project/penpot/issue/1406)
- Fix issue with rotated blur [Taiga #1370](https://tree.taiga.io/project/penpot/issue/1370)
- Fix issue with rotation degree input [#741](https://github.com/penpot/penpot/issues/741)
- Fix issue with system shortcuts and application [#737](https://github.com/penpot/penpot/issues/737)
- Fix issue with team management in dashboard [Taiga #1475](https://tree.taiga.io/project/penpot/issue/1475)
- Fix issue with typographies panel cannot be collapsed [#707](https://github.com/penpot/penpot/issues/707)
- Fix text selection in comments [#745](https://github.com/penpot/penpot/issues/745)
- Update Work-Sans font [#744](https://github.com/penpot/penpot/issues/744)
- Fix issue with recent files not showing [Taiga #1493](https://tree.taiga.io/project/penpot/issue/1493)
- Fix issue when promoting to owner [Taiga #1494](https://tree.taiga.io/project/penpot/issue/1494)
- Fix cannot click on blocked elements in viewer [Taiga #1430](https://tree.taiga.io/project/penpot/issue/1430)
- Fix SVG not showing properties at code [Taiga #1437](https://tree.taiga.io/project/penpot/issue/1437)
- Fix shadows when exporting groups [Taiga #1495](https://tree.taiga.io/project/penpot/issue/1495)
- Fix drag-select when renaming layer text [Taiga #1307](https://tree.taiga.io/project/penpot/issue/1307)
- Fix layout problem for editable selects [Taiga #1488](https://tree.taiga.io/project/penpot/issue/1488)
- Fix artboard title wasn't move when resizing [Taiga #1479](https://tree.taiga.io/project/penpot/issue/1479)
- Fix titles in viewer thumbnails too long [Taiga #1474](https://tree.taiga.io/project/penpot/issue/1474)
- Fix when right click on a selected text shows artboard contextual menu [Taiga #1226](https://tree.taiga.io/project/penpot/issue/1226)
### :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)
- gizembln [#759](https://github.com/penpot/penpot/pull/759)
- 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
@ -29,7 +105,7 @@
- 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).
- Disables filters in masking elements (problem with Firefox rendering)
- 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)
- Fix corner cases on invitation/signup flows.
@ -37,8 +113,8 @@
- Fix infinite recursion on logout.
- Fix issues with frame selection [Taiga #1300](https://tree.taiga.io/project/penpot/issue/1300), [Taiga #1255](https://tree.taiga.io/project/penpot/issue/1255)
- Fix local fonts error [#691](https://github.com/penpot/penpot/issues/691)
- Fix problem width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
- Fix problem with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
- Fix issue width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
- Fix issue with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
- 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.
@ -71,16 +147,16 @@
- Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
- Fix 500 when requestion password reset
- Fix Problems when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
- Fix issue when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
- Fix apply a color to a text selection from color palette was not working [Taiga #1189](https://tree.taiga.io/project/penpot/issue/1189)
- Fix issues when moving shapes outside groups [Taiga #1138](https://tree.taiga.io/project/penpot/issue/1138)
- Fix ldap function called on login click
- Fix logo icon in viewer should go to dashboard [Taiga #1149](https://tree.taiga.io/project/penpot/issue/1149)
- Fix ordering when restoring deleted shapes in sync [Taiga #1163](https://tree.taiga.io/project/penpot/issue/1163)
- Fix problem when editing text immediately after creating [Taiga #1207](https://tree.taiga.io/project/penpot/issue/1207)
- Fix problem when pasting URL's copied from the browser url bar [Taiga #1187](https://tree.taiga.io/project/penpot/issue/1187)
- Fix problem with multiple selection and groups [Taiga #1128](https://tree.taiga.io/project/penpot/issue/1128)
- Fix problem with red handler indicator on resize [Taiga #1188](https://tree.taiga.io/project/penpot/issue/1188)
- Fix issue when editing text immediately after creating [Taiga #1207](https://tree.taiga.io/project/penpot/issue/1207)
- Fix issue when pasting URL's copied from the browser url bar [Taiga #1187](https://tree.taiga.io/project/penpot/issue/1187)
- Fix issue with multiple selection and groups [Taiga #1128](https://tree.taiga.io/project/penpot/issue/1128)
- Fix issue with red handler indicator on resize [Taiga #1188](https://tree.taiga.io/project/penpot/issue/1188)
- Fix show correct error when google auth is disabled [Taiga #1119](https://tree.taiga.io/project/penpot/issue/1119)
- Fix text alignment in preview [#594](https://github.com/penpot/penpot/issues/594)
- Fix unexpected exception when uploading image [Taiga #1120](https://tree.taiga.io/project/penpot/issue/1120)

25
README.md
View file

@ -9,27 +9,14 @@
# PENPOT #
We’re excited to share that Uxbox is now Penpot! We’re changing the name, but keeping the same project essence. Stay in the loop for more news coming early 2021. Alpha release is close!
Penpot is the first Open Source design and prototyping platform meant
for cross-domain teams. Non dependent on operating systems, Penpot is
web based and works with open web standards (SVG). For all and
empowered by the community.
![PENPOT](https://raw.githubusercontent.com/penpot/penpot/develop/docs/screenshot.png)
![PENPOT](https://penpot.app/images/workspace-ui.jpg)
## Introduction ##
The open-source solution for design and prototyping. PENPOT is
currently at an early development stage but we are working hard to
bring you the beta version as soon as possible. Follow the project
progress in Twitter or Github and stay tuned!
## SVG based ##
Penpot works with SVG, a standard format, for all your designs and
prototypes . This means that all your stuff in Penpot is portable and
editable in many other vector tools and easy to use on the web.
[See SVG specification](https://www.w3.org/Graphics/SVG/)
## Contributing ##
**Open to you!**
@ -43,7 +30,7 @@ Please refer to the [Contributing Guide](./CONTRIBUTING.md)
## Documentation ##
Please refer to [docs/ directory](./docs/).
Please refer to the [help center](https://help.penpot.app).
## License ##

46
backend/deps.edn
View file

@ -3,27 +3,28 @@
"clojars" {:url "https://clojars.org/repo"}
"jcenter" {:url "https://jcenter.bintray.com/"}}
:deps
{org.clojure/clojure {:mvn/version "1.10.2"}
{org.clojure/clojure {:mvn/version "1.10.3"}
org.clojure/clojurescript {:mvn/version "1.10.773"}
org.clojure/data.json {:mvn/version "1.0.0"}
org.clojure/data.json {:mvn/version "1.1.0"}
org.clojure/core.async {:mvn/version "1.3.610"}
org.clojure/tools.cli {:mvn/version "1.0.194"}
org.clojure/tools.cli {:mvn/version "1.0.206"}
;; Logging
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.14.0"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.14.0"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.14.0"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.0"}
org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.0"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.14.1"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.14.1"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.14.1"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.1"}
org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.1"}
org.slf4j/slf4j-api {:mvn/version "1.7.30"}
org.zeromq/jeromq {:mvn/version "0.5.2"}
org.graalvm.js/js {:mvn/version "20.3.0"}
com.taoensso/nippy {:mvn/version "3.1.1"}
com.github.luben/zstd-jni {:mvn/version "1.4.8-3"}
com.github.luben/zstd-jni {:mvn/version "1.4.9-1"}
;; 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"
@ -32,19 +33,19 @@
io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
selmer/selmer {:mvn/version "1.12.33"}
expound/expound {:mvn/version "0.8.7"}
expound/expound {:mvn/version "0.8.9"}
com.cognitect/transit-clj {:mvn/version "1.0.324"}
io.lettuce/lettuce-core {:mvn/version "6.0.2.RELEASE"}
java-http-clj/java-http-clj {:mvn/version "0.4.1"}
java-http-clj/java-http-clj {:mvn/version "0.4.2"}
info.sunng/ring-jetty9-adapter {:mvn/version "0.14.2"}
seancorfield/next.jdbc {:mvn/version "1.1.613"}
metosin/reitit-ring {:mvn/version "0.5.11"}
info.sunng/ring-jetty9-adapter {:mvn/version "0.15.0"}
com.github.seancorfield/next.jdbc {:mvn/version "1.1.646"}
metosin/reitit-ring {:mvn/version "0.5.12"}
metosin/jsonista {:mvn/version "0.3.1"}
org.postgresql/postgresql {:mvn/version "42.2.18"}
com.zaxxer/HikariCP {:mvn/version "3.4.5"}
org.postgresql/postgresql {:mvn/version "42.2.19"}
com.zaxxer/HikariCP {:mvn/version "4.0.3"}
funcool/datoteka {:mvn/version "1.2.0"}
funcool/promesa {:mvn/version "6.0.0"}
@ -63,13 +64,12 @@
org.im4java/im4java {:mvn/version "1.4.0"}
org.lz4/lz4-java {:mvn/version "1.7.1"}
commons-io/commons-io {:mvn/version "2.8.0"}
org.apache.commons/commons-pool2 {:mvn/version "2.9.0"}
com.sun.mail/jakarta.mail {:mvn/version "2.0.0"}
puppetlabs/clj-ldap {:mvn/version"0.3.0"}
org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
integrant/integrant {:mvn/version "0.8.0"}
software.amazon.awssdk/s3 {:mvn/version "2.15.73"}
software.amazon.awssdk/s3 {:mvn/version "2.16.19"}
;; exception printing
io.aviso/pretty {:mvn/version "0.1.37"}
@ -92,11 +92,11 @@
:args {}}
:tests
{:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
{:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.829"}}
:main-opts ["-m" "kaocha.runner"]}
:outdated
{:extra-deps {antq/antq {:mvn/version "RELEASE"}}
{:extra-deps {com.github.liquidz/antq {:mvn/version "0.12.0"}}
:main-opts ["-m" "antq.core"]}
:jmx-remote

11
backend/resources/builtin.edn
View file

@ -1,11 +0,0 @@
{:icons
[{:name "Material Design (Action)"
:path "./material/action/svg/production"
:regex #"^.*_48px\.svg$"}]
:images
[{:name "Generic Collection 1"
:path "./my-images/collection1/"
:regex #"^.*\.(png|jpg|webp)$"}]}

44
backend/resources/config/default.edn
View file

@ -1,44 +0,0 @@
{;; A secret key used for create tokens
;; WARNING: this is a default secret key and
;; it should be overwritten in production env.
:secret "5qjiAn-QUpawUNqGP10UZKklSqbLKcdGY3sJpq0UUACpVXGg2HOFJCBejDWVHskhRyp7iHb4rjOLXX2ZjF-5cw"
:registration
{
:enabled true}
:smtp
{:host "localhost" ;; Hostname of the desired SMTP server.
:port 25 ;; Port of SMTP server.
:user nil ;; Username to authenticate with (if authenticating).
:pass nil ;; Password to authenticate with (if authenticating).
:ssl false ;; Enables SSL encryption if value is truthy.
:tls false ;; Enables TLS encryption if value is truthy.
:enabled false ;; Enables SMTP if value is truthy.
:noop true}
:auth-options {:alg :a256kw :enc :a128cbc-hs256}
:email {:reply-to "no-reply@uxbox.io"
:from "no-reply@uxbox.io"
:support "support@uxbox.io"}
:http {:port 6060
:max-body-size 52428800
:debug true}
:media
{:directory "resources/public/media"
:uri "http://localhost:6060/media/"}
:static
{:directory "resources/public/static"
:uri "http://localhost:6060/static/"}
:database
{:adapter "postgresql"
:username nil
:password nil
:database-name "uxbox"
:server-name "localhost"
:port-number 5432}}

18
backend/resources/config/test.edn
View file

@ -1,18 +0,0 @@
{:migrations
{:verbose false}
:media
{:directory "/tmp/uxbox/media"
:uri "http://localhost:6060/media/"}
:static
{:directory "/tmp/uxbox/static"
:uri "http://localhost:6060/static/"}
:database
{:adapter "postgresql"
:username nil
:password nil
:database-name "test"
:server-name "localhost"
:port-number 5432}}

21
backend/resources/log4j2-bundle.xml
View file

@ -1,21 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<Configuration status="info" monitorInterval="60">
<Appenders>
<Console name="console" target="SYSTEM_OUT">
<PatternLayout pattern="[%t] %level{length=1} %logger{36} - %msg%n"/>
</Console>
</Appenders>
<Loggers>
<Logger name="com.zaxxer.hikari" level="error" />
<Logger name="org.eclipse.jetty" level="error" />
<Logger name="app" level="debug" additivity="false">
<AppenderRef ref="console" />
</Logger>
<Root level="info">
<AppenderRef ref="console" />
</Root>
</Loggers>
</Configuration>

43
backend/resources/log4j2-devenv.xml Normal file
View file

@ -0,0 +1,43 @@
<?xml version="1.0" encoding="UTF-8"?>
<Configuration status="info" monitorInterval="30">
<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"/>
</Console>
<RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
<Policies>
<SizeBasedTriggeringPolicy size="50M"/>
</Policies>
<DefaultRolloverStrategy max="9"/>
</RollingFile>
</Appenders>
<Loggers>
<Logger name="com.zaxxer.hikari" level="error"/>
<Logger name="io.lettuce" level="error" />
<Logger name="org.eclipse.jetty" level="error" />
<Logger name="org.postgresql" level="error" />
<Logger name="app.cli" level="debug" additivity="false">
<AppenderRef ref="console"/>
</Logger>
<Logger name="app.loggers" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" />
</Logger>
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Logger name="user" level="trace" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Root level="info">
<AppenderRef ref="main" />
</Root>
</Loggers>
</Configuration>

39
backend/resources/log4j2.xml
View file

@ -1,50 +1,21 @@
<?xml version="1.0" encoding="UTF-8"?>
<Configuration status="info" monitorInterval="30">
<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"/>
</Console>
<RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
<Policies>
<SizeBasedTriggeringPolicy size="50M"/>
</Policies>
<DefaultRolloverStrategy max="9"/>
</RollingFile>
<JeroMQ name="zmq">
<Property name="endpoint">tcp://localhost:45556</Property>
<JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
</JeroMQ>
</Appenders>
<Loggers>
<Logger name="com.zaxxer.hikari" level="error"/>
<Logger name="io.lettuce" level="error" />
<Logger name="com.zaxxer.hikari" level="error" />
<Logger name="org.eclipse.jetty" level="error" />
<Logger name="org.postgresql" level="error" />
<Logger name="app.cli" level="debug" additivity="false">
<AppenderRef ref="console"/>
</Logger>
<Logger name="app.loggers" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" />
</Logger>
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
<AppenderRef ref="zmq" level="debug" />
</Logger>
<Logger name="user" level="trace" additivity="false">
<AppenderRef ref="main" level="trace" />
<AppenderRef ref="zmq" level="debug" />
<Logger name="app" level="debug" additivity="false">
<AppenderRef ref="console" />
</Logger>
<Root level="info">
<AppenderRef ref="main" />
<AppenderRef ref="console" />
</Root>
</Loggers>
</Configuration>

94
backend/resources/svgclean.js
View file

File diff suppressed because one or more lines are too long

81
backend/scripts/build Executable file
View file

@ -0,0 +1,81 @@
#!/usr/bin/env bb
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) UXBOX Labs SL
(ns build
(:require
[clojure.string :as str]
[clojure.java.io :as io]
[clojure.pprint :refer [pprint]]
[babashka.fs :as fs]
[babashka.process :refer [$ check]]))
(defn split-cp
[data]
(str/split data #":"))
(def classpath
(->> ($ clojure -Spath)
(check)
(:out)
(slurp)
(split-cp)
(map str/trim)))
(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

77
backend/scripts/build.sh
View file

@ -1,77 +0,0 @@
#!/usr/bin/env bash
CLASSPATH=`(clojure -Spath)`
NEWCP="./main:./common"
rm -rf ./target/dist
mkdir -p ./target/dist/deps
for item in $(echo $CLASSPATH | tr ":" "\n"); do
if [ "${item: -4}" == ".jar" ]; then
cp $item ./target/dist/deps/;
BN="$(basename -- $item)"
NEWCP+=":./deps/$BN"
fi
done
cp ./resources/log4j2-bundle.xml ./target/dist/log4j2.xml
cp -r ./src ./target/dist/main
cp -r ./resources/emails ./target/dist/main/
cp -r ./resources/svgclean.js ./target/dist/main/
cp -r ./resources/error-report.tmpl ./target/dist/main/
cp -r ../common ./target/dist/common
echo $NEWCP > ./target/dist/classpath;
tee -a ./target/dist/run.sh >> /dev/null <<EOF
#!/usr/bin/env bash
CP="$NEWCP"
set +e
JAVA_CMD=\$(type -p java)
set -e
if [[ ! -n "\$JAVA_CMD" ]]; then
if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
JAVA_CMD="\$JAVA_HOME/bin/java"
else
>&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
exit 1
fi
fi
if [ -f ./environ ]; then
source ./environ
fi
set -x
exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
EOF
tee -a ./target/dist/manage.sh >> /dev/null <<EOF
#!/usr/bin/env bash
CP="$NEWCP"
set +e
JAVA_CMD=\$(type -p java)
set -e
if [[ ! -n "\$JAVA_CMD" ]]; then
if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
JAVA_CMD="\$JAVA_HOME/bin/java"
else
>&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
exit 1
fi
fi
if [ -f ./environ ]; then
source ./environ
fi
exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "\$@"
EOF
chmod +x ./target/dist/run.sh
chmod +x ./target/dist/manage.sh

4
backend/scripts/import-generic-collections.sh
View file

@ -1,4 +0,0 @@
#!/usr/bin/env bash
clojure -Adev -m app.cli.collimp $@

19
backend/scripts/manage.template.sh Normal file
View file

@ -0,0 +1,19 @@
#!/usr/bin/env bash
set +e
JAVA_CMD=$(type -p java)
set -e
if [[ ! -n "$JAVA_CMD" ]]; then
if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
JAVA_CMD="$JAVA_HOME/bin/java"
else
>&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
exit 1
fi
fi
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 "\$@"

16
backend/scripts/prepare-release.sh
View file

@ -1,16 +0,0 @@
#!/usr/bin/env bash
if [ "$#" -e 0 ]; then
echo "Expecting parameters: 1=path to backend; 2=destination directory"
exit 1
fi
rm -rf $2 || exit 1;
rsync -avr \
--exclude="/test" \
--exclude="/resources/public/media" \
--exclude="/target" \
--exclude="/scripts" \
--exclude="/.*" \
$1 $2;

2
backend/scripts/psql.sh
View file

@ -1,2 +0,0 @@
#!/usr/bin/env bash
PGPASSWORD=$PENPOT_DATABASE_PASSWORD psql $PENPOT_DATABASE_URI -U $PENPOT_DATABASE_USERNAME

3
backend/scripts/repl
View file

@ -2,7 +2,8 @@
export PENPOT_ASSERTS_ENABLED=true
export OPTIONS="-A:jmx-remote:dev -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Xms512m -J-Xmx512m"
export OPTIONS="-A:jmx-remote:dev -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Xms512m -J-Xmx512m -J-Dlog4j2.configurationFile=log4j2-devenv.xml"
export OPTIONS_EVAL="nil"
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

4
backend/scripts/run-tests-in-docker.sh
View file

@ -1,4 +0,0 @@
#!/usr/bin/env bash
set -xe
clojure -Adev -m app.tests.main;

20
backend/scripts/run.template.sh Normal file
View file

@ -0,0 +1,20 @@
#!/usr/bin/env bash
set +e
JAVA_CMD=$(type -p java)
set -e
if [[ ! -n "$JAVA_CMD" ]]; then
if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
JAVA_CMD="$JAVA_HOME/bin/java"
else
>&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
exit 1
fi
fi
if [ -f ./environ ]; then
source ./environ
fi
set -x
exec $JAVA_CMD $JVM_OPTS -classpath "$(cat classpath)" -Dlog4j2.configurationFile=./log4j2.xml "$@" clojure.main -m app.main

2
backend/scripts/smtpd.sh
View file

@ -1,2 +0,0 @@
#!/usr/bin/env bash
python -m smtpd -n -c DebuggingServer localhost:25

2
backend/scripts/tests.sh
View file

@ -1,2 +0,0 @@
#!/usr/bin/env sh
exec clojure -M:dev:tests "$@"

16
backend/src/app/cli/fixtures.clj
View file

@ -132,12 +132,18 @@
(range (:num-files-per-project opts))))
(create-project [conn team-id owner-id index]
(let [id (mk-uuid "project" team-id index)
name (str "project " index)]
(let [id (if index
(mk-uuid "project" team-id index)
(mk-uuid "project" team-id))
name (if index
(str "project " index)
"Drafts")
is-default (nil? index)]
(log/info "create project" index id)
(db/insert! conn :project
{:id id
:team-id team-id
:is-default is-default
:name name})
(db/insert! conn :project-profile-rel
{:project-id id
@ -150,8 +156,10 @@
(create-projects [conn team-id profile-ids]
(log/info "create projects")
(let [owner-id (rng-nth rng profile-ids)
project-ids (collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))]
project-ids (conj
(collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))
(create-project conn team-id owner-id nil))]
(run! (partial create-files conn owner-id) project-ids)))
(assign-profile-to-team [conn team-id owner? profile-id]

16
backend/src/app/config.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020-2021 UXBOX Labs SL
;; Copyright (c) UXBOX Labs SL
(ns app.config
"A configuration management."
@ -15,6 +15,7 @@
[app.common.version :as v]
[app.util.time :as dt]
[clojure.core :as c]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[environ.core :refer [env]]))
@ -23,7 +24,7 @@
{:http-server-port 6060
:host "devenv"
:tenant "dev"
:database-uri "postgresql://127.0.0.1/penpot"
:database-uri "postgresql://postgres/penpot"
:database-username "penpot"
:database-password "penpot"
@ -34,14 +35,14 @@
:asserts-enabled false
:public-uri "http://localhost:3449"
:redis-uri "redis://localhost/0"
:redis-uri "redis://redis/0"
:srepl-host "127.0.0.1"
:srepl-port 6062
:storage-backend :fs
:storage-fs-directory "resources/public/assets"
:storage-fs-directory "assets"
:storage-s3-region :eu-central-1
:storage-s3-bucket "penpot-devenv-assets-pre"
@ -70,7 +71,7 @@
:telemetry-enabled false
:telemetry-uri "https://telemetry.penpot.app/"
:ldap-user-query "(|(uid=$username)(mail=$username))"
:ldap-user-query "(|(uid=:username)(mail=:username))"
:ldap-attrs-username "uid"
:ldap-attrs-email "mail"
:ldap-attrs-fullname "cn"
@ -251,7 +252,10 @@
:migrations-verbose false}
(read-config env)))
(def version (v/parse "%version%"))
(def version (v/parse (or (some-> (io/resource "version.txt")
(slurp)
(str/trim))
"%version%")))
(def config (read-config env))
(def test-config (read-test-config env))

14
backend/src/app/db.clj
View file

@ -80,7 +80,7 @@
#'next.jdbc/execute!]
{:registry registry
:type :counter
:name "database_query_count"
:name "database_query_total"
:help "An absolute counter of database queries."}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -217,9 +217,10 @@
(defn get-by-params
([ds table params]
(get-by-params ds table params nil))
([ds table params opts]
([ds table params {:keys [uncheked] :or {uncheked false} :as opts}]
(let [res (exec-one! ds (sql/select table params opts))]
(when (or (:deleted-at res) (not res))
(when (and (not uncheked)
(or (:deleted-at res) (not res)))
(ex/raise :type :not-found
:hint "database object not found"))
res)))
@ -261,9 +262,12 @@
(PGpoint. (:x p) (:y p)))
(defn create-array
[conn type aobjects]
[conn type objects]
(let [^PGConnection conn (unwrap conn org.postgresql.PGConnection)]
(.createArrayOf conn ^String type aobjects)))
(if (coll? objects)
(.createArrayOf conn ^String type (into-array Object objects))
(.createArrayOf conn ^String type objects))))
(defn decode-pgpoint
[^PGpoint v]

1
backend/src/app/db/sql.clj
View file

@ -58,4 +58,3 @@
([table where-params opts]
(let [opts (merge default-opts opts)]
(sql/for-delete table where-params opts))))

5
backend/src/app/http.clj
View file

@ -128,7 +128,8 @@
["/webhooks"
["/sns" {:post (:sns-webhook cfg)}]]
["/api" {:middleware [[middleware/format-response-body]
["/api" {:middleware [[middleware/etag]
[middleware/format-response-body]
[middleware/params]
[middleware/multipart-params]
[middleware/keyword-params]
@ -136,7 +137,7 @@
[middleware/errors errors/handle]
[middleware/cookies]]}
["/svg" {:post svgparse}]
["/svg/parse" {:post svgparse}]
["/feedback" {:middleware [(:middleware session)]
:post feedback}]

54
backend/src/app/http/errors.clj
View file

@ -10,6 +10,7 @@
(ns app.http.errors
"A errors handling for the http server."
(:require
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.util.log4j :refer [update-thread-context!]]
[clojure.tools.logging :as log]
@ -86,15 +87,54 @@
(defmethod handle-exception :default
[error request]
(let [cdata (get-error-context request error)]
(let [edata (ex-data error)]
;; NOTE: this is a special case for the idle-in-transaction error;
;; when it happens, the connection is automatically closed and
;; next-jdbc combines the two errors in a single ex-info. We only
;; need the :handling error, because the :rollback error will be
;; always "connection closed".
(if (and (ex/exception? (:rollback edata))
(ex/exception? (:handling edata)))
(handle-exception (:handling edata) request)
(let [cdata (get-error-context request error)]
(update-thread-context! cdata)
(log/errorf error "internal error: %s (id: %s)"
(ex-message error)
(str (:id cdata)))
{:status 500
:body {:type :server-error
:hint (ex-message error)
:data edata}}))))
(defmethod handle-exception org.postgresql.util.PSQLException
[error request]
(let [cdata (get-error-context request error)
state (.getSQLState ^java.sql.SQLException error)]
(update-thread-context! cdata)
(log/errorf error "internal error: %s (id: %s)"
(log/errorf error "PSQL Exception: %s (id: %s, state: %s)"
(ex-message error)
(str (:id cdata)))
{:status 500
:body {:type :server-error
:hint (ex-message error)
:data (ex-data error)}}))
(str (:id cdata))
state)
(cond
(= state "57014")
{:status 504
:body {:type :server-timeout
:code :statement-timeout
:hint (ex-message error)}}
(= state "25P03")
{:status 504
:body {:type :server-timeout
:code :idle-in-transaction-timeout
:hint (ex-message error)}}
:else
{:status 500
:body {:type :server-timeout
:hint (ex-message error)
:state state}})))
(defn handle
[error req]

29
backend/src/app/http/middleware.clj
View file

@ -12,6 +12,8 @@
[app.metrics :as mtx]
[app.util.json :as json]
[app.util.transit :as t]
[buddy.core.codecs :as bc]
[buddy.core.hash :as bh]
[clojure.java.io :as io]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
@ -119,8 +121,6 @@
:wrap (fn [handler]
(mtx/wrap-counter handler {:id "http__requests_counter"
:help "Absolute http requests counter."}))})
(def cookies
{:name ::cookies
:compile (constantly wrap-cookies)})
@ -140,3 +140,28 @@
(def server-timing
{:name ::server-timing
:compile (constantly wrap-server-timing)})
(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)))))
(def etag
{:name ::etag
:compile (constantly wrap-etag)})

2
backend/src/app/http/session.clj
View file

@ -137,7 +137,7 @@
(str (:max-batch-size cfg)))
(let [input (batch-events cfg (::events-ch session))
mcnt (mtx/create
{:name "http_session_updater_count"
{:name "http_session_update_total"
:help "A counter of session update batch events."
:registry (:registry metrics)
:type :counter})]

12
backend/src/app/main.clj
View file

@ -58,7 +58,8 @@
{}
:app.msgbus/msgbus
{:uri (:redis-uri config)}
{:backend (:msgbus-backend config :redis)
:redis-uri (:redis-uri config)}
:app.tokens/tokens
{:sprops (ig/ref :app.setup/props)}
@ -155,13 +156,9 @@
:client-id (:gitlab-client-id config)
:client-secret (:gitlab-client-secret config)}
:app.svgparse/svgc
{:metrics (ig/ref :app.metrics/metrics)}
;; HTTP Handler for SVG parsing
:app.svgparse/handler
{:metrics (ig/ref :app.metrics/metrics)
:svgc (ig/ref :app.svgparse/svgc)}
{:metrics (ig/ref :app.metrics/metrics)}
;; RLimit definition for password hashing
:app.rlimits/password
@ -183,8 +180,7 @@
:metrics (ig/ref :app.metrics/metrics)
:storage (ig/ref :app.storage/storage)
:msgbus (ig/ref :app.msgbus/msgbus)
:rlimits (ig/ref :app.rlimits/all)
:svgc (ig/ref :app.svgparse/svgc)}
:rlimits (ig/ref :app.rlimits/all)}
:app.notifications/handler
{:msgbus (ig/ref :app.msgbus/msgbus)

7
backend/src/app/media.clj
View file

@ -157,8 +157,11 @@
:code :media-type-mismatch
:hint (str "Seems like you are uploading a file whose content does not match the extension."
"Expected: " mtype ". Got: " mtype')))
{:width (.getImageWidth instance)
:height (.getImageHeight instance)
;; For an animated GIF, getImageWidth/Height returns the delta size of one frame (if no frame given
;; it returns size of the last one), whereas getPageWidth/Height always return the full size of
;; any frame.
{:width (.getPageWidth instance)
:height (.getPageHeight instance)
:mtype mtype}))))
(defmethod process :default

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

@ -163,6 +163,9 @@
{:name "0050-mod-server-prop-table"
:fn (mg/resource "app/migrations/sql/0050-mod-server-prop-table.sql")}
{:name "0051-mod-file-library-rel-table"
:fn (mg/resource "app/migrations/sql/0051-mod-file-library-rel-table.sql")}
])

4
backend/src/app/migrations/sql/0051-mod-file-library-rel-table.sql Normal file
View file

@ -0,0 +1,4 @@
ALTER TABLE file_library_rel
DROP CONSTRAINT file_library_rel_library_file_id_fkey,
ADD CONSTRAINT file_library_rel_library_file_id_fkey
FOREIGN KEY (library_file_id) REFERENCES file(id) ON DELETE CASCADE DEFERRABLE;

331
backend/src/app/msgbus.clj
View file

@ -33,56 +33,49 @@
io.lettuce.core.pubsub.StatefulRedisPubSubConnection
io.lettuce.core.pubsub.api.async.RedisPubSubAsyncCommands))
(declare impl-publish-loop)
(declare impl-redis-pub)
(declare impl-redis-sub)
(declare impl-redis-unsub)
(declare impl-subscribe-loop)
(def ^:private prefix (cfg/get :tenant))
(defn- prefix-topic
[topic]
(str prefix "." topic))
;; --- STATE INIT: Publisher
(def xform-prefix (map prefix-topic))
(def xform-topics (map (fn [m] (update m :topics #(into #{} xform-prefix %)))))
(def xform-topic (map (fn [m] (update m :topic prefix-topic))))
(s/def ::uri ::us/string)
(s/def ::redis-uri ::us/string)
(s/def ::buffer-size ::us/integer)
(defmulti init-backend :backend)
(defmulti stop-backend :backend)
(defmulti init-pub-loop :backend)
(defmulti init-sub-loop :backend)
(defmethod ig/pre-init-spec ::msgbus [_]
(s/keys :req-un [::uri]
:opt-un [::buffer-size]))
(s/keys :opt-un [::buffer-size ::redis-uri]))
(defmethod ig/prep-key ::msgbus
[_ cfg]
(merge {:buffer-size 128} cfg))
(defmethod ig/init-key ::msgbus
[_ {:keys [uri buffer-size] :as cfg}]
(let [codec (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
uri (RedisURI/create uri)
rclient (RedisClient/create ^RedisURI uri)
snd-conn (.connect ^RedisClient rclient ^RedisCodec codec)
rcv-conn (.connectPubSub ^RedisClient rclient ^RedisCodec codec)
[_ {:keys [backend buffer-size] :as cfg}]
(log/debugf "initializing msgbus (backend=%s)" (name backend))
(let [cfg (init-backend cfg)
;; Channel used for receive publications from the application.
pub-chan (a/chan (a/dropping-buffer buffer-size))
;; Channel used for receive data from redis
rcv-chan (a/chan (a/dropping-buffer buffer-size))
pub-ch (-> (a/dropping-buffer buffer-size)
(a/chan xform-topic))
;; Channel used for receive subscription requests.
sub-chan (a/chan)
cch (a/chan 1)]
sub-ch (a/chan 1 xform-topics)
(.setTimeout ^StatefulRedisConnection snd-conn ^Duration (dt/duration {:seconds 10}))
(.setTimeout ^StatefulRedisPubSubConnection rcv-conn ^Duration (dt/duration {:seconds 10}))
cfg (-> cfg
(assoc ::pub-ch pub-ch)
(assoc ::sub-ch sub-ch))]
(log/debugf "initializing msgbus (uri: '%s')" (str uri))
;; Start the sending (publishing) loop
(impl-publish-loop snd-conn pub-chan cch)
;; Start the receiving (subscribing) loop
(impl-subscribe-loop rcv-conn rcv-chan sub-chan cch)
(init-pub-loop cfg)
(init-sub-loop cfg)
(with-meta
(fn run
@ -90,124 +83,166 @@
([command params]
(a/go
(case command
:pub (a/>! pub-chan params)
:sub (a/>! sub-chan params)))))
{::snd-conn snd-conn
::rcv-conn rcv-conn
::cch cch
::pub-chan pub-chan
::rcv-chan rcv-chan})))
:pub (a/>! pub-ch params)
:sub (a/>! sub-ch params)))))
cfg)))
(defmethod ig/halt-key! ::msgbus
[_ f]
(let [mdata (meta f)]
(.close ^StatefulRedisConnection (::snd-conn mdata))
(.close ^StatefulRedisPubSubConnection (::rcv-conn mdata))
(a/close! (::cch mdata))
(a/close! (::pub-chan mdata))
(a/close! (::rcv-chan mdata))))
(stop-backend mdata)
(a/close! (::pub-ch mdata))
(a/close! (::sub-ch mdata))))
(defn- impl-publish-loop
[conn pub-chan cch]
(let [rac (.async ^StatefulRedisConnection conn)]
;; --- IN-MEMORY BACKEND IMPL
(defmethod init-backend :memory [cfg] cfg)
(defmethod stop-backend :memory [_])
(defmethod init-pub-loop :memory [_])
(defmethod init-sub-loop :memory
[{:keys [::sub-ch ::pub-ch]}]
(a/go-loop [state {}]
(let [[val port] (a/alts! [pub-ch sub-ch])]
(cond
(and (= port sub-ch) (some? val))
(let [{:keys [topics chan]} val]
(recur (reduce #(update %1 %2 (fnil conj #{}) chan) state topics)))
(and (= port pub-ch) (some? val))
(let [topic (:topic val)
message (:message val)
state (loop [state state
chans (get state topic)]
(if-let [c (first chans)]
(if (a/>! c message)
(recur state (rest chans))
(recur (update state topic disj c)
(rest chans)))
state))]
(recur state))
:else
(->> (vals state)
(mapcat identity)
(run! a/close!))))))
;; Add a unique listener to connection
;; --- REDIS BACKEND IMPL
(declare impl-redis-pub)
(declare impl-redis-sub)
(declare impl-redis-unsub)
(defmethod init-backend :redis
[{:keys [redis-uri] :as cfg}]
(let [codec (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
uri (RedisURI/create redis-uri)
rclient (RedisClient/create ^RedisURI uri)
pub-conn (.connect ^RedisClient rclient ^RedisCodec codec)
sub-conn (.connectPubSub ^RedisClient rclient ^RedisCodec codec)]
(.setTimeout ^StatefulRedisConnection pub-conn ^Duration (dt/duration {:seconds 10}))
(.setTimeout ^StatefulRedisPubSubConnection sub-conn ^Duration (dt/duration {:seconds 10}))
(-> cfg
(assoc ::pub-conn pub-conn)
(assoc ::sub-conn sub-conn))))
(defmethod stop-backend :redis
[{:keys [::pub-conn ::sub-conn] :as cfg}]
(.close ^StatefulRedisConnection pub-conn)
(.close ^StatefulRedisPubSubConnection sub-conn))
(defmethod init-pub-loop :redis
[{:keys [::pub-conn ::pub-ch]}]
(let [rac (.async ^StatefulRedisConnection pub-conn)]
(a/go-loop []
(let [[val _] (a/alts! [cch pub-chan] :priority true)]
(when (some? val)
(let [result (a/<! (impl-redis-pub rac val))]
(when (ex/exception? result)
(log/error result "unexpected error on publish message to redis")))
(recur))))))
(when-let [val (a/<! pub-ch)]
(let [result (a/<! (impl-redis-pub rac val))]
(when (ex/exception? result)
(log/error result "unexpected error on publish message to redis")))
(recur)))))
(defn- impl-subscribe-loop
[conn rcv-chan sub-chan cch]
;; Add a unique listener to connection
(.addListener conn (reify RedisPubSubListener
(message [it pattern topic message])
(message [it topic message]
;; There are no back pressure, so we use a slidding
;; buffer for cases when the pubsub broker sends
;; more messages that we can process.
(let [val {:topic topic :message (blob/decode message)}]
(when-not (a/offer! rcv-chan val)
(log/warn "dropping message on subscription loop"))))
(psubscribed [it pattern count])
(punsubscribed [it pattern count])
(subscribed [it topic count])
(unsubscribed [it topic count])))
(defmethod init-sub-loop :redis
[{:keys [::sub-conn ::sub-ch buffer-size]}]
(let [rcv-ch (a/chan (a/dropping-buffer buffer-size))
chans (agent {} :error-handler #(log/error % "unexpected error on agent"))
rac (.async ^StatefulRedisPubSubConnection sub-conn)]
(let [chans (agent {} :error-handler #(log/error % "unexpected error on agent"))
tprefix (str (cfg/get :tenant) ".")
;; Add a unique listener to connection
(.addListener sub-conn
(reify RedisPubSubListener
(message [it pattern topic message])
(message [it topic message]
;; There are no back pressure, so we use a slidding
;; buffer for cases when the pubsub broker sends
;; more messages that we can process.
(let [val {:topic topic :message (blob/decode message)}]
(when-not (a/offer! rcv-ch val)
(log/warn "dropping message on subscription loop"))))
(psubscribed [it pattern count])
(punsubscribed [it pattern count])
(subscribed [it topic count])
(unsubscribed [it topic count])))
subscribe-to-single-topic
(fn [nsubs topic chan]
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
(when (= 1 (count nsubs))
(let [result (a/<!! (impl-redis-sub conn topic))]
(log/tracef "opening subscription to %s" topic)
(when (ex/exception? result)
(log/errorf result "unexpected exception on subscribing to '%s'" topic))))
nsubs))
(letfn [(subscribe-to-single-topic [nsubs topic chan]
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
(when (= 1 (count nsubs))
(let [result (a/<!! (impl-redis-sub rac topic))]
(log/tracef "opening subscription to %s" topic)
(when (ex/exception? result)
(log/errorf result "unexpected exception on subscribing to '%s'" topic))))
nsubs))
subscribe-to-topics
(fn [state topics chan]
(let [state (update state :chans assoc chan topics)]
(reduce (fn [state topic]
(update-in state [:topics topic] subscribe-to-single-topic topic chan))
state
topics)))
(subscribe-to-topics [state topics chan]
(let [state (update state :chans assoc chan topics)]
(reduce (fn [state topic]
(update-in state [:topics topic] subscribe-to-single-topic topic chan))
state
topics)))
unsubscribe-from-single-topic
(fn [nsubs topic chan]
(let [nsubs (disj nsubs chan)]
(when (empty? nsubs)
(let [result (a/<!! (impl-redis-unsub conn topic))]
(log/tracef "closing subscription to %s" topic)
(when (ex/exception? result)
(log/errorf result "unexpected exception on unsubscribing from '%s'" topic))))
nsubs))
(unsubscribe-from-single-topic [nsubs topic chan]
(let [nsubs (disj nsubs chan)]
(when (empty? nsubs)
(let [result (a/<!! (impl-redis-unsub rac topic))]
(log/tracef "closing subscription to %s" topic)
(when (ex/exception? result)
(log/errorf result "unexpected exception on unsubscribing from '%s'" topic))))
nsubs))
unsubscribe-channels
(fn [state pending]
(reduce (fn [state ch]
(let [topics (get-in state [:chans ch])
state (update state :chans dissoc ch)]
(reduce (fn [state topic]
(update-in state [:topics topic] unsubscribe-from-single-topic topic ch))
state
topics)))
state
pending))]
(unsubscribe-channels [state pending]
(reduce (fn [state ch]
(let [topics (get-in state [:chans ch])
state (update state :chans dissoc ch)]
(reduce (fn [state topic]
(update-in state [:topics topic] unsubscribe-from-single-topic topic ch))
state
topics)))
state
pending))]
;; Asynchronous subscription loop; terminates when sub-chan is
;; closed.
(a/go-loop []
(when-let [{:keys [topics chan]} (a/<! sub-chan)]
(let [topics (into #{} (map #(str tprefix %)) topics)]
(send-off chans subscribe-to-topics topics chan)
(recur))))
(a/go-loop []
(let [[val port] (a/alts! [cch rcv-chan])]
(cond
;; Stop condition; close all underlying subscriptions and
;; exit. The close operation is performed asynchronously.
(= port cch)
(send-off chans (fn [state]
(log/tracef "close")
(->> (vals state)
(mapcat identity)
(filter some?)
(run! a/close!))))
;; Asynchronous subscription loop;
(a/go-loop []
(if-let [{:keys [topics chan]} (a/<! sub-ch)]
(do
(send-off chans subscribe-to-topics topics chan)
(recur))
(a/close! rcv-ch)))
;; Asyncrhonous 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
;; forward it to the underlying subscriptions.
(= port rcv-chan)
(let [topic (:topic val) ; topic is already string
pending (loop [chans (seq (get-in @chans [:topics topic]))
(let [pending (loop [chans (seq (get-in @chans [:topics topic]))
pending #{}]
(if-let [ch (first chans)]
(if (a/>! ch (:message val))
(if (a/>! ch message)
(recur (rest chans) pending)
(recur (rest chans) (conj pending ch)))
pending))]
@ -215,34 +250,40 @@
(some->> (seq pending)
(send-off chans unsubscribe-channels))
(recur)))))))
(recur))
;; Stop condition; close all underlying subscriptions and
;; exit. The close operation is performed asynchronously.
(send-off chans (fn [state]
(->> (vals state)
(mapcat identity)
(filter some?)
(run! a/close!)))))))))
(defn- impl-redis-pub
[rac {:keys [topic message]}]
(let [topic (str (cfg/get :tenant) "." topic)
message (blob/encode message)
[^RedisAsyncCommands rac {:keys [topic message]}]
(let [message (blob/encode message)
res (a/chan 1)]
(-> (.publish ^RedisAsyncCommands rac ^String topic ^bytes message)
(-> (.publish rac ^String topic ^bytes message)
(p/finally (fn [_ e]
(when e (a/>!! res e))
(a/close! res))))
res))
(defn impl-redis-sub
[conn topic]
(let [^RedisPubSubAsyncCommands cmd (.async ^StatefulRedisPubSubConnection conn)
res (a/chan 1)]
(-> (.subscribe cmd (into-array String [topic]))
[^RedisPubSubAsyncCommands rac topic]
(let [res (a/chan 1)]
(-> (.subscribe rac (into-array String [topic]))
(p/finally (fn [_ e]
(when e (a/>!! res e))
(a/close! res))))
res))
(defn impl-redis-unsub
[conn topic]
(let [^RedisPubSubAsyncCommands cmd (.async ^StatefulRedisPubSubConnection conn)
res (a/chan 1)]
(-> (.unsubscribe cmd (into-array String [topic]))
[rac topic]
(let [res (a/chan 1)]
(-> (.unsubscribe rac (into-array String [topic]))
(p/finally (fn [_ e]
(when e (a/>!! res e))
(a/close! res))))

148
backend/src/app/notifications.clj
View file

@ -24,9 +24,7 @@
[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]])
(:import
org.eclipse.jetty.websocket.api.WebSocketAdapter))
[ring.middleware.params :refer [wrap-params]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Http Handler
@ -55,7 +53,7 @@
mtx-messages
(mtx/create
{:name "websocket_message_count"
{:name "websocket_message_total"
:registry (:registry metrics)
:labels ["op"]
:type :counter
@ -194,100 +192,58 @@
;; --- CONNECTION INIT
(declare send-presence)
(declare handle-message)
(declare start-loop!)
(defn- handle-connect
[{:keys [conn] :as cfg}]
[cfg]
(a/go
(try
(aa/<? (handle-message cfg {:type :connect}))
(aa/<? (start-loop! cfg))
(aa/<? (handle-message cfg {:type :disconnect}))
(catch Throwable err
(log/errorf err "unexpected exception on websocket handler")
(let [session (.getSession ^WebSocketAdapter conn)]
(when session
(.disconnect session)))))))
(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}]
(aa/go-try
(loop []
(let [timeout (a/timeout 30000)
[val port] (a/alts! [rcv-ch sub-ch timeout])]
(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))
(cond
;; Process message coming from connected client
(and (= port rcv-ch) (some? val))
(do
(aa/<? (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)))
;; If message comes from subscription channel; we just need
;; to foreward it to the output channel.
(and (= port sub-ch) (some? val))
(do
(when-not (= (:session-id val) session-id)
(a/>! out-ch val))
(recur))
;; 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))
;; 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))))))
:else
nil)))))
;; --- PRESENCE HANDLING API
(def ^:private
sql:retrieve-presence
"select * from presence
where file_id=?
and (clock_timestamp() - updated_at) < '5 min'::interval")
(def ^:private
sql:update-presence
"insert into presence (file_id, session_id, profile_id, updated_at)
values (?, ?, ?, clock_timestamp())
on conflict (file_id, session_id, profile_id)
do update set updated_at=clock_timestamp()")
(defn- retrieve-presence
[{:keys [pool file-id] :as cfg}]
(let [rows (db/exec! pool [sql:retrieve-presence file-id])]
(mapv (juxt :session-id :profile-id) rows)))
(defn- retrieve-presence*
[{:keys [executor] :as cfg}]
(aa/with-thread executor
(retrieve-presence cfg)))
(defn- update-presence
[{:keys [pool file-id session-id profile-id] :as cfg}]
(let [sql [sql:update-presence file-id session-id profile-id]]
(db/exec-one! pool sql)))
(defn- update-presence*
[{:keys [executor] :as cfg}]
(aa/with-thread executor
(update-presence cfg)))
(defn- delete-presence
[{:keys [pool file-id session-id profile-id] :as cfg}]
(db/delete! pool :presence {:file-id file-id
:profile-id profile-id
:session-id session-id}))
(defn- delete-presence*
[{:keys [executor] :as cfg}]
(aa/with-thread executor
(delete-presence cfg)))
(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
@ -295,26 +251,18 @@
(fn [_ message] (:type message)))
(defmethod handle-message :connect
[{:keys [file-id msgbus] :as cfg} _message]
[cfg _]
;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
(aa/go-try
(aa/<? (update-presence* cfg))
(let [members (aa/<? (retrieve-presence* cfg))
val {:topic file-id :message {:type :presence :sessions members}}]
(a/<! (msgbus :pub val)))))
(send-presence cfg :connect))
(defmethod handle-message :disconnect
[{:keys [file-id msgbus] :as cfg} _message]
[cfg _]
;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
(aa/go-try
(aa/<? (delete-presence* cfg))
(let [members (aa/<? (retrieve-presence* cfg))
val {:topic file-id :message {:type :presence :sessions members}}]
(a/<! (msgbus :pub val)))))
(send-presence cfg :disconnect))
(defmethod handle-message :keepalive
[cfg _message]
(update-presence* cfg))
[_ _]
(a/go :nothing))
(defmethod handle-message :pointer-update
[{:keys [profile-id file-id session-id msgbus] :as cfg} message]

4
backend/src/app/rpc.clj
View file

@ -41,7 +41,8 @@
mdata (meta result)]
(cond->> {:status 200 :body result}
(fn? (:transform-response mdata)) ((:transform-response mdata) request))))
(fn? (:transform-response mdata))
((:transform-response mdata) request))))
(defn- rpc-mutation-handler
[methods {:keys [profile-id] :as request}]
@ -135,6 +136,7 @@
'app.rpc.mutations.projects
'app.rpc.mutations.viewer
'app.rpc.mutations.teams
'app.rpc.mutations.management
'app.rpc.mutations.ldap
'app.rpc.mutations.verify-token)
(map (partial process-method cfg))

4
backend/src/app/rpc/mutations/comments.clj
View file

@ -146,14 +146,14 @@
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread
(ex/raise :type :not-found)
(ex/raise :type :not-found))
(files/check-read-permissions! conn profile-id (:file-id thread))
(db/update! conn :comment-thread
{:is-resolved is-resolved}
{:id id})
nil))))
nil)))
;; --- Mutation: Add Comment

20
backend/src/app/rpc/mutations/files.clj
View file

@ -16,6 +16,7 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.rpc.permissions :as perms]
[app.rpc.queries.files :as files]
[app.rpc.queries.projects :as proj]
[app.tasks :as tasks]
@ -47,14 +48,13 @@
(proj/check-edition-permissions! conn profile-id project-id)
(create-file conn params)))
(defn- create-file-profile
[conn {:keys [profile-id file-id] :as params}]
(db/insert! conn :file-profile-rel
{:profile-id profile-id
:file-id file-id
:is-owner true
:is-admin true
:can-edit true}))
(defn create-file-role
[conn {:keys [file-id profile-id role]}]
(let [params {:file-id file-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :file-profile-rel))))
(defn create-file
[conn {:keys [id name project-id is-shared]
@ -68,8 +68,8 @@
:name name
:is-shared is-shared
:data (blob/encode data)})]
(->> (assoc params :file-id id)
(create-file-profile conn))
(->> (assoc params :file-id id :role :owner)
(create-file-role conn))
(assoc file :data data)))

56
backend/src/app/rpc/mutations/ldap.clj
View file

@ -16,23 +16,23 @@
[app.util.services :as sv]
[clj-ldap.client :as ldap]
[clojure.spec.alpha :as s]
[clojure.string]
[clojure.tools.logging :as log]))
[clojure.string]))
(def cpool
(delay
(let [params {:ssl? (cfg/get :ldap-ssl)
:startTLS? (cfg/get :ldap-starttls)
:bind-dn (cfg/get :ldap-bind-dn)
:password (cfg/get :ldap-bind-password)
:host {:address (cfg/get :ldap-host)
:port (cfg/get :ldap-port)}}]
(try
(ldap/connect params)
(catch Exception e
(log/errorf e "cannot connect to LDAP %s:%s"
(get-in params [:host :address])
(get-in params [:host :port])))))))
(defn ^java.lang.AutoCloseable connect
[]
(let [params {:ssl? (cfg/get :ldap-ssl)
:startTLS? (cfg/get :ldap-starttls)
:bind-dn (cfg/get :ldap-bind-dn)
:password (cfg/get :ldap-bind-password)
:host {:address (cfg/get :ldap-host)
:port (cfg/get :ldap-port)}}]
(try
(ldap/connect params)
(catch Exception e
(ex/raise :type :restriction
:code :ldap-disabled
:hint "ldap disabled or unable to connect"
:cause e)))))
;; --- Mutation: login-with-ldap
@ -48,12 +48,7 @@
(sv/defmethod ::login-with-ldap {:auth false :rlimit :password}
[{:keys [pool session tokens] :as cfg} {:keys [email password invitation-token] :as params}]
(when-not @cpool
(ex/raise :type :restriction
:code :ldap-disabled
:hint "ldap disabled or unable to connect"))
(let [info (authenticate @cpool params)
(let [info (authenticate params)
cfg (assoc cfg :conn pool)]
(when-not info
(ex/raise :type :validation
@ -84,7 +79,7 @@
(defn- get-ldap-user
[cpool {:keys [email] :as params}]
(let [query (-> (cfg/get :ldap-user-query)
(replace-several "$username" email))
(replace-several ":username" email))
attrs [(cfg/get :ldap-attrs-username)
(cfg/get :ldap-attrs-email)
@ -96,10 +91,11 @@
(first (ldap/search cpool base-dn params))))
(defn- authenticate
[cpool {:keys [password] :as params}]
(when-let [{:keys [dn] :as luser} (get-ldap-user cpool params)]
(when (ldap/bind? cpool dn password)
{:photo (get luser (keyword (cfg/get :ldap-attrs-photo)))
:fullname (get luser (keyword (cfg/get :ldap-attrs-fullname)))
:email (get luser (keyword (cfg/get :ldap-attrs-email)))
:backend "ldap"})))
[{:keys [password] :as params}]
(with-open [conn (connect)]
(when-let [{:keys [dn] :as luser} (get-ldap-user conn params)]
(when (ldap/bind? conn dn password)
{:photo (get luser (keyword (cfg/get :ldap-attrs-photo)))
:fullname (get luser (keyword (cfg/get :ldap-attrs-fullname)))
:email (get luser (keyword (cfg/get :ldap-attrs-email)))
:backend "ldap"}))))

325
backend/src/app/rpc/mutations/management.clj Normal file
View file

@ -0,0 +1,325 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2021 UXBOX Labs SL
(ns app.rpc.mutations.management
"Move & Duplicate RPC methods for files and projects."
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc.mutations.projects :refer [create-project-role create-project]]
[app.rpc.queries.projects :as proj]
[app.rpc.queries.teams :as teams]
[app.util.blob :as blob]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.walk :as walk]))
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::name ::us/string)
(defn- remap-id
[item index key]
(cond-> item
(contains? item key)
(assoc key (get index (get item key) (get item key)))))
(defn- process-file
[file index]
(letfn [(process-form [form]
(cond-> form
;; Relink Components
(and (map? form)
(uuid? (:component-file form)))
(update :component-file #(get index % %))
;; Relink Image Shapes
(and (map? form)
(map? (:metadata form))
(= :image (:type form)))
(update-in [:metadata :id] #(get index % %))))
;; A function responsible to analize all file data and
;; replace the old :component-file reference with the new
;; ones, using the provided file-index
(relink-shapes [data]
(walk/postwalk process-form data))
;; A function responsible of process the :media attr of file
;; data and remap the old ids with the new ones.
(relink-media [media]
(reduce-kv (fn [res k v]
(let [id (get index k)]
(if (uuid? id)
(-> res
(assoc id (assoc v :id id))
(dissoc k))
res)))
media
media))]
(update file :data
(fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(pmg/migrate-data)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(d/without-nils)
(blob/encode))))))
(def sql:retrieve-used-libraries
"select flr.*
from file_library_rel as flr
inner join file as l on (flr.library_file_id = l.id)
where flr.file_id = ?
and l.deleted_at is null")
(def sql:retrieve-used-media-objects
"select fmo.*
from file_media_object as fmo
inner join storage_object as o on (fmo.media_id = o.id)
where fmo.file_id = ?
and o.deleted_at is null")
(defn duplicate-file
[conn {:keys [profile-id file index project-id name]} {:keys [reset-shared-flag] :as opts}]
(let [flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)])
fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)])
;; memo uniform creation/modification date
now (dt/now)
ignore (dt/plus now (dt/duration {:seconds 5}))
;; add to the index all file media objects.
index (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
flibs-xf (comp
(map #(remap-id % index :file-id))
(map #(remap-id % index :library-file-id))
(map #(assoc % :synced-at now))
(map #(assoc % :created-at now)))
;; remap all file-library-rel row
flibs (sequence flibs-xf flibs)
fmeds-xf (comp
(map #(assoc % :id (get index (:id %))))
(map #(assoc % :created-at now))
(map #(remap-id % index :file-id)))
;; remap all file-media-object rows
fmeds (sequence fmeds-xf fmeds)
file (cond-> file
(some? project-id)
(assoc :project-id project-id)
(some? name)
(assoc :name name)
(true? reset-shared-flag)
(assoc :is-shared false))
file (-> file
(assoc :created-at now)
(assoc :modified-at now)
(assoc :ignore-sync-until ignore)
(update :id #(get index %))
(process-file index))]
(db/insert! conn :file file)
(db/insert! conn :file-profile-rel
{:file-id (:id file)
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true})
(doseq [params flibs]
(db/insert! conn :file-library-rel params))
(doseq [params fmeds]
(db/insert! conn :file-media-object params))
file))
;; --- MUTATION: Duplicate File
(declare duplicate-file)
(s/def ::duplicate-file
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::name]))
(sv/defmethod ::duplicate-file
[{:keys [pool] :as cfg} {:keys [profile-id file-id name] :as params}]
(db/with-atomic [conn pool]
(let [file (db/get-by-id conn :file file-id)
index {file-id (uuid/next)}
params (assoc params :index index :file file)]
(proj/check-edition-permissions! conn profile-id (:project-id file))
(-> (duplicate-file conn params {:reset-shared-flag true})
(update :data blob/decode)))))
;; --- MUTATION: Duplicate Project
(declare duplicate-project)
(s/def ::duplicate-project
(s/keys :req-un [::profile-id ::project-id]
:opt-un [::name]))
(sv/defmethod ::duplicate-project
[{:keys [pool] :as cfg} {:keys [profile-id project-id name] :as params}]
(db/with-atomic [conn pool]
(let [project (db/get-by-id conn :project project-id)]
(teams/check-edition-permissions! conn profile-id (:team-id project))
(duplicate-project conn (assoc params :project project)))))
(defn duplicate-project
[conn {:keys [profile-id project name] :as params}]
(let [files (db/query conn :file
{:project-id (:id project)
:deleted-at nil}
{:columns [:id]})
project (cond-> project
(string? name)
(assoc :name name)
:always
(assoc :id (uuid/next)))]
;; create the duplicated project and assign the current profile as
;; a project owner
(create-project conn project)
(create-project-role conn {:project-id (:id project)
:profile-id profile-id
:role :owner})
;; duplicate all files
(let [index (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
params (-> params
(dissoc :name)
(assoc :project-id (:id project))
(assoc :index index))]
(doseq [{:keys [id]} files]
(let [file (db/get-by-id conn :file id)
params (assoc params :file file)
opts {:reset-shared-flag false}]
(duplicate-file conn params opts))))
;; return the created project
project))
;; --- MUTATION: Move file
(def sql:retrieve-files
"select id, project_id from file where id = ANY(?)")
(def sql:move-files
"update file set project_id = ? where id = ANY(?)")
(def sql:delete-broken-relations
"with broken as (
(select * from file_library_rel as flr
inner join file as f on (flr.file_id = f.id)
inner join project as p on (f.project_id = p.id)
inner join file as lf on (flr.library_file_id = lf.id)
inner join project as lp on (lf.project_id = lp.id)
where p.id = ANY(?)
and lp.team_id != p.team_id)
)
delete from file_library_rel as rel
using broken as br
where rel.file_id = br.file_id
and rel.library_file_id = br.library_file_id")
(s/def ::ids (s/every ::us/uuid :kind set?))
(s/def ::move-files
(s/keys :req-un [::profile-id ::ids ::project-id]))
(sv/defmethod ::move-files
[{:keys [pool] :as cfg} {:keys [profile-id ids project-id] :as params}]
(db/with-atomic [conn pool]
(let [fids (db/create-array conn "uuid" ids)
files (db/exec! conn [sql:retrieve-files fids])
source (into #{} (map :project-id) files)
pids (->> (conj source project-id)
(db/create-array conn "uuid"))]
;; Check if we have permissions on the destination project
(proj/check-edition-permissions! conn profile-id project-id)
;; Check if we have permissions on all source projects
(doseq [project-id source]
(proj/check-edition-permissions! conn profile-id project-id))
(when (contains? source project-id)
(ex/raise :type :validation
:code :cant-move-to-same-project
:hint "Unable to move a file to the same project"))
;; move all files to the project
(db/exec-one! conn [sql:move-files project-id fids])
;; delete posible broken relations on moved files
(db/exec-one! conn [sql:delete-broken-relations pids])
nil)))
;; --- MUTATION: Move project
(declare move-project)
(s/def ::move-project
(s/keys :req-un [::profile-id ::team-id ::project-id]))
(sv/defmethod ::move-project
[{:keys [pool] :as cfg} {:keys [profile-id team-id project-id] :as params}]
(db/with-atomic [conn pool]
(let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})
pids (->> (db/query conn :project {:team-id (:team-id project)} {:columns [:id]})
(map :id)
(db/create-array conn "uuid"))]
(teams/check-edition-permissions! conn profile-id (:team-id project))
(teams/check-edition-permissions! conn profile-id team-id)
(when (= team-id (:team-id project))
(ex/raise :type :validation
:code :cant-move-to-same-team
:hint "Unable to move a project to same team"))
;; move project to the destination team
(db/update! conn :project
{:team-id team-id}
{:id project-id})
;; delete posible broken relations on moved files
(db/exec-one! conn [sql:delete-broken-relations pids])
nil)))

4
backend/src/app/rpc/mutations/media.clj
View file

@ -92,7 +92,7 @@
(defn create-file-media-object
[{:keys [conn storage svgc] :as cfg} {:keys [file-id is-local name content] :as params}]
[{:keys [conn storage] :as cfg} {:keys [file-id is-local name content] :as params}]
(media/validate-media-type (:content-type content))
(let [storage (assoc storage :conn conn)
source-path (fs/path (:tempfile content))
@ -108,7 +108,7 @@
:path source-path})))
image (if (= (:mtype source-info) "image/svg+xml")
(let [data (svgc (slurp source-path))]
(let [data (slurp source-path)]
(sto/put-object storage {:content (sto/content data)
:content-type (:mtype source-info)}))
(sto/put-object storage {:content (sto/content source-path)

32
backend/src/app/rpc/mutations/profile.clj
View file

@ -202,21 +202,25 @@
(defn create-profile-relations
[conn profile]
(let [team (teams/create-team conn {:profile-id (:id profile)
:name "Default"
:default? true})
proj (projects/create-project conn {:profile-id (:id profile)
:team-id (:id team)
:name "Drafts"
:default? true})]
(teams/create-team-profile conn {:team-id (:id team)
:profile-id (:id profile)})
(projects/create-project-profile conn {:project-id (:id proj)
:profile-id (:id profile)})
(let [team (teams/create-team conn {:profile-id (:id profile)
:name "Default"
:is-default true})
project (projects/create-project conn {:profile-id (:id profile)
:team-id (:id team)
:name "Drafts"
:is-default true})
params {:team-id (:id team)
:profile-id (:id profile)
:project-id (:id project)
:role :owner}]
(merge (profile/strip-private-attrs profile)
{:default-team-id (:id team)
:default-project-id (:id proj)})))
(teams/create-team-role conn params)
(projects/create-project-role conn params)
(-> profile
(profile/strip-private-attrs)
(assoc :default-team-id (:id team))
(assoc :default-project-id (:id project)))))
;; --- Mutation: Login

34
backend/src/app/rpc/mutations/projects.clj
View file

@ -13,6 +13,7 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.rpc.permissions :as perms]
[app.rpc.queries.projects :as proj]
[app.rpc.queries.teams :as teams]
[app.tasks :as tasks]
@ -30,7 +31,7 @@
;; --- Mutation: Create Project
(declare create-project)
(declare create-project-profile)
(declare create-project-role)
(declare create-team-project-profile)
(s/def ::team-id ::us/uuid)
@ -43,30 +44,31 @@
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(let [project (create-project conn params)
params (assoc params :project-id (:id project))]
(create-project-profile conn params)
params (assoc params
:project-id (:id project)
:role :owner)]
(create-project-role conn params)
(create-team-project-profile conn params)
(assoc project :is-pinned true))))
(defn create-project
[conn {:keys [id team-id name default?] :as params}]
(let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)]
[conn {:keys [id team-id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :project
{:id id
:team-id team-id
:name name
:is-default default?})))
:team-id team-id
:is-default is-default})))
(defn create-project-profile
[conn {:keys [project-id profile-id] :as params}]
(db/insert! conn :project-profile-rel
{:project-id project-id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true}))
(defn create-project-role
[conn {:keys [project-id profile-id role]}]
(let [params {:project-id project-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :project-profile-rel))))
;; TODO: pending to be refactored
(defn create-team-project-profile
[conn {:keys [team-id project-id profile-id] :as params}]
(db/insert! conn :team-project-profile-rel

62
backend/src/app/rpc/mutations/teams.clj
View file

@ -18,6 +18,7 @@
[app.emails :as emails]
[app.media :as media]
[app.rpc.mutations.projects :as projects]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
@ -36,7 +37,7 @@
;; --- Mutation: Create Team
(declare create-team)
(declare create-team-profile)
(declare create-team-role)
(declare create-team-default-project)
(s/def ::create-team
@ -47,37 +48,39 @@
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(let [team (create-team conn params)
params (assoc params :team-id (:id team))]
(create-team-profile conn params)
params (assoc params
:team-id (:id team)
:role :owner)]
(create-team-role conn params)
(create-team-default-project conn params)
team)))
(defn create-team
[conn {:keys [id name default?] :as params}]
(let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)]
[conn {:keys [id name is-default] :as params}]
(let [id (or id (uuid/next))
is-default (if (boolean? is-default) is-default false)]
(db/insert! conn :team
{:id id
:name name
:is-default default?})))
:is-default is-default})))
(defn create-team-profile
[conn {:keys [team-id profile-id] :as params}]
(db/insert! conn :team-profile-rel
{:team-id team-id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true}))
(defn create-team-role
[conn {:keys [team-id profile-id role] :as params}]
(let [params {:team-id team-id
:profile-id profile-id}]
(->> (perms/assign-role-flags params role)
(db/insert! conn :team-profile-rel))))
(defn create-team-default-project
[conn {:keys [team-id profile-id] :as params}]
(let [proj (projects/create-project conn {:team-id team-id
:name "Drafts"
:default? true})]
(projects/create-project-profile conn {:project-id (:id proj)
:profile-id profile-id})))
(let [project {:id (uuid/next)
:team-id team-id
:name "Drafts"
:is-default true}]
(projects/create-project conn project)
(projects/create-project-role conn {:project-id (:id project)
:profile-id profile-id
:role :owner})))
;; --- Mutation: Update Team
@ -171,7 +174,10 @@
;; convenience, if this bocomes a bottleneck or problematic,
;; we will change it to more efficient fetch mechanims.
members (teams/retrieve-team-members conn team-id)
member (d/seek #(= member-id (:id %)) members)]
member (d/seek #(= member-id (:id %)) members)
is-owner? (some :is-owner perms)
is-admin? (some :is-admin perms)]
;; If no member is found, just 404
(when-not member
@ -179,8 +185,7 @@
:code :member-does-not-exist))
;; First check if we have permissions to change roles
(when-not (or (some :is-owner perms)
(some :is-admin perms))
(when-not (or is-owner? is-admin?)
(ex/raise :type :validation
:code :insufficient-permissions))
@ -190,21 +195,20 @@
:code :cant-change-role-to-owner))
;; Don't allow promote to owner to admin users.
(when (and (= role :owner)
(not (:is-owner perms)))
(when (and (not is-owner?) (= role :owner))
(ex/raise :type :validation
:code :cant-promote-to-owner))
(let [params (role->params role)]
;; Only allow single owner on team
(when (and (= role :owner)
(:is-owner perms))
(when (= role :owner)
(db/update! conn :team-profile-rel
{:is-owner false}
{:team-id team-id
:profile-id profile-id}))
(db/update! conn :team-profile-rel params
(db/update! conn :team-profile-rel
params
{:team-id team-id
:profile-id member-id})
nil))))

29
backend/src/app/rpc/permissions.clj
View file

@ -11,7 +11,34 @@
"A permission checking helper factories."
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]))
[app.common.spec :as us]
[clojure.spec.alpha :as s]))
(s/def ::role #{:admin :owner :editor :viewer})
(defn assign-role-flags
[params role]
(us/verify ::role role)
(cond-> params
(= role :owner)
(assoc :is-owner true
:is-admin true
:can-edit true)
(= role :admin)
(assoc :is-owner false
:is-admin true
:can-edit true)
(= role :editor)
(assoc :is-owner false
:is-admin false
:can-edit true)
(= role :viewer)
(assoc :is-owner false
:is-admin false
:can-edit false)))
(defn make-edition-check-fn
"A simple factory for edition permission check functions."

1
backend/src/app/rpc/queries/files.clj
View file

@ -166,7 +166,6 @@
(let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id]))))
;; --- Query: Shared Library Files
(def ^:private sql:shared-files

45
backend/src/app/rpc/queries/projects.clj
View file

@ -82,6 +82,50 @@
(db/exec! conn [sql:projects profile-id team-id]))
;; --- Query: All projects
(declare retrieve-all-projects)
(s/def ::profile-id ::us/uuid)
(s/def ::all-projects
(s/keys :req-un [::profile-id]))
(sv/defmethod ::all-projects
[{:keys [pool]} {:keys [profile-id]}]
(with-open [conn (db/open pool)]
(retrieve-all-projects conn profile-id)))
(def sql:all-projects
"select p1.*, t.name as team_name, t.is_default as is_default_team
from project as p1
inner join team as t
on t.id = p1.team_id
where t.id in (select team_id
from team_profile_rel as tpr
where tpr.profile_id = ?
and (tpr.can_edit = true or
tpr.is_owner = true or
tpr.is_admin = true))
and p1.deleted_at is null
union
select p2.*, t.name as team_name, t.is_default as is_default_team
from project as p2
inner join team as t
on t.id = p2.team_id
where p2.id in (select project_id
from project_profile_rel as ppr
where ppr.profile_id = ?
and (ppr.can_edit = true or
ppr.is_owner = true or
ppr.is_admin = true))
and p2.deleted_at is null
order by team_name, name;")
(defn retrieve-all-projects
[conn profile-id]
(db/exec! conn [sql:all-projects profile-id profile-id]))
;; --- Query: Project
(s/def ::id ::us/uuid)
@ -94,3 +138,4 @@
(let [project (db/get-by-id conn :project id)]
(check-read-permissions! conn profile-id id)
project)))

2
backend/src/app/rpc/queries/recent_files.clj
View file

@ -27,7 +27,7 @@
window w as (partition by f.project_id order by f.modified_at desc)
order by f.modified_at desc
)
select * from recent_files where row_num <= 6;")
select * from recent_files where row_num <= 10;")
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)

130
backend/src/app/setup/initial_data.clj
View file

@ -10,16 +10,12 @@
(ns app.setup.initial-data
(:refer-clojure :exclude [load])
(:require
[app.common.data :as d]
[app.common.pages.migrations :as pmg]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.rpc.mutations.projects :as projects]
[app.rpc.queries.profile :as profile]
[app.util.blob :as blob]
[app.util.time :as dt]
[clojure.walk :as walk]))
[app.rpc.mutations.management :refer [duplicate-file]]
[app.rpc.mutations.projects :refer [create-project create-project-role]]
[app.rpc.queries.profile :as profile]))
;; --- DUMP GENERATION
@ -62,58 +58,6 @@
;; --- DUMP LOADING
(defn- process-file
[file index]
(letfn [(process-form [form]
(cond-> form
;; Relink Components
(and (map? form)
(uuid? (:component-file form)))
(update :component-file #(get index % %))
;; Relink Image Shapes
(and (map? form)
(map? (:metadata form))
(= :image (:type form)))
(update-in [:metadata :id] #(get index % %))))
;; A function responsible to analize all file data and
;; replace the old :component-file reference with the new
;; ones, using the provided file-index
(relink-shapes [data]
(walk/postwalk process-form data))
;; A function responsible of process the :media attr of file
;; data and remap the old ids with the new ones.
(relink-media [media]
(reduce-kv (fn [res k v]
(let [id (get index k)]
(if (uuid? id)
(-> res
(assoc id (assoc v :id id))
(dissoc k))
res)))
media
media))]
(update file :data
(fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(pmg/migrate-data)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(d/without-nils)
(blob/encode))))))
(defn- remap-id
[item index key]
(cond-> item
(contains? item key)
(assoc key (get index (get item key) (get item key)))))
(defn- retrieve-data
[conn skey]
(when-let [row (db/exec-one! conn ["select content from server_prop where id = ?" skey])]
@ -127,60 +71,26 @@
(let [skey (or (:skey opts) (cfg/get :initial-project-skey))
data (retrieve-data conn skey)]
(when data
(let [project (projects/create-project conn {:profile-id (:id profile)
:team-id (:default-team-id profile)
:name (:project-name data)})
(let [index (reduce #(assoc %1 (:id %2) (uuid/next)) {} (:files data))
project {:id (uuid/next)
:profile-id (:id profile)
:team-id (:default-team-id profile)
:name (:project-name data)}]
now (dt/now)
ignore (dt/plus now (dt/duration {:seconds 5}))
index (as-> {} index
(reduce #(assoc %1 (:id %2) (uuid/next)) index (:files data))
(reduce #(assoc %1 (:id %2) (uuid/next)) index (:fmeds data)))
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
flibs (->> (:flibs data)
(map #(remap-id % index :file-id))
(map #(remap-id % index :library-file-id))
(map #(assoc % :synced-at now))
(map #(assoc % :created-at now)))
(create-project conn project)
(create-project-role conn {:project-id (:id project)
:profile-id (:id profile)
:role :owner})
files (->> (:files data)
(map #(assoc % :id (get index (:id %))))
(map #(assoc % :project-id (:id project)))
(map #(assoc % :created-at now))
(map #(assoc % :modified-at now))
(map #(assoc % :ignore-sync-until ignore))
(map #(process-file % index)))
fmeds (->> (:fmeds data)
(map #(assoc % :id (get index (:id %))))
(map #(assoc % :created-at now))
(map #(remap-id % index :file-id)))
fprofs (map #(array-map :file-id (:id %)
:profile-id (:id profile)
:is-owner true
:is-admin true
:can-edit true) files)]
(projects/create-project-profile conn {:project-id (:id project)
:profile-id (:id profile)})
(projects/create-team-project-profile conn {:team-id (:default-team-id profile)
:project-id (:id project)
:profile-id (:id profile)})
;; Re-insert into the database
(doseq [params files]
(db/insert! conn :file params))
(doseq [params fprofs]
(db/insert! conn :file-profile-rel params))
(doseq [params flibs]
(db/insert! conn :file-library-rel params))
(doseq [params fmeds]
(db/insert! conn :file-media-object params)))))))
(doseq [file (:files data)]
(let [params {:profile-id (:id profile)
:project-id (:id project)
:file file
:index index}
opts {:reset-shared-flag false}]
(duplicate-file conn params opts))))))))
(defn load
[system {:keys [email] :as opts}]

104
backend/src/app/svgparse.clj
View file

@ -5,90 +5,19 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
;; Copyright (c) UXBOX Labs SL
(ns app.svgparse
(:require
[app.common.exceptions :as ex]
[app.metrics :as mtx]
[app.util.graal :as graal]
[app.util.pool :as pool]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[clojure.xml :as xml]
[integrant.core :as ig])
(:import
java.util.function.Consumer
org.apache.commons.io.IOUtils))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SVG Clean
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare clean-svg)
(declare prepare-context-pool)
(defmethod ig/pre-init-spec ::svgc [_]
(s/keys :req-un [::mtx/metrics]))
(defmethod ig/init-key ::svgc
[_ {:keys [metrics] :as cfg}]
(let [pool (prepare-context-pool cfg)
cfg (assoc cfg :pool pool)
handler #(clean-svg cfg %)
handler (->> {:registry (:registry metrics)
:type :summary
:name "svgc_timing"
:help "svg optimization function timing"}
(mtx/instrument handler))]
(with-meta handler {::pool pool})))
(defmethod ig/halt-key! ::svgc
[_ f]
(let [{:keys [::pool]} (meta f)]
(pool/clear! pool)
(pool/close! pool)))
(defn- prepare-context-pool
[cfg]
(pool/create
{:min-idle (:min-idle cfg 0)
:max-idle (:max-idle cfg 3)
:max-total (:max-total cfg 3)
:create
(fn []
(let [ctx (graal/context "js")]
(->> (graal/source "js" (io/resource "svgclean.js"))
(graal/eval! ctx))
ctx))
:destroy
(fn [ctx]
(graal/close! ctx))}))
(defn- clean-svg
[{:keys [pool]} data]
(with-open [ctx (pool/acquire pool)]
(let [res (promise)
optimize (-> (graal/get-bindings @ctx "js")
(graal/get-member "svgc")
(graal/get-member "optimize"))
resultp (graal/invoke optimize data)]
(graal/invoke-member resultp "then"
(reify Consumer
(accept [_ val]
(deliver res val))))
(graal/invoke-member resultp "catch"
(reify Consumer
(accept [_ err]
(deliver res err))))
(let [result (deref res)]
(if (instance? Throwable result)
(throw result)
result)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -96,10 +25,8 @@
(declare handler)
(declare process-request)
(s/def ::svgc fn?)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::mtx/metrics ::svgc]))
(s/keys :req-un [::mtx/metrics]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
@ -111,26 +38,35 @@
(mtx/instrument handler))))
(defn- handler
[cfg {:keys [headers body] :as request}]
[_ {:keys [headers body] :as request}]
(when (not= "image/svg+xml" (get headers "content-type"))
(ex/raise :type :validation
:code :unsupported-mime-type
:mime (get headers "content-type")))
{:status 200
:body (process-request cfg body)})
:body (process-request body)})
(defn secure-factory
[s ch]
(.. (doto (javax.xml.parsers.SAXParserFactory/newInstance)
(.setFeature javax.xml.XMLConstants/FEATURE_SECURE_PROCESSING true)
(.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true))
(newSAXParser)
(parse s ch)))
(defn parse
[data]
(try
(with-open [istream (IOUtils/toInputStream data "UTF-8")]
(xml/parse istream))
(catch Exception _e
(xml/parse istream secure-factory))
(catch Exception e
(log/warnf "error on processing svg: %s" (ex-message e))
(ex/raise :type :validation
:code :invalid-svg-file))))
:code :invalid-svg-file
:cause e))))
(defn process-request
[{:keys [svgc] :as cfg} body]
(let [data (slurp body)
data (svgc data)]
[body]
(let [data (slurp body)]
(parse data)))

4
backend/src/app/tasks.clj
View file

@ -54,8 +54,8 @@
{:registry registry
:type :counter
:labels ["name"]
:name "tasks_submit_counter"
:help "An absolute counter of task submissions."
:name "tasks_submit_total"
:help "A counter of task submissions."
:wrap (fn [rootf mobj]
(let [mdata (meta rootf)
origf (::original mdata rootf)]

60
backend/src/app/util/graal.clj
View file

@ -1,60 +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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2021 UXBOX Labs SL
(ns app.util.graal
"Graal Polyglot integration layer."
(:import
org.graalvm.polyglot.Context
org.graalvm.polyglot.Source
org.graalvm.polyglot.Value))
(defn ^Source source
[lang content]
(if (string? content)
(Source/create ^String lang ^String content)
(.. (Source/newBuilder lang content)
(build))))
(defn ^Context context
[lang]
(.. (Context/newBuilder (into-array String [lang]))
(allowAllAccess true)
(allowIO true)
(build)))
(defn ^Value eval!
[ctx source]
(.eval ^Context ctx ^Source source))
(defn ^Value get-bindings
[ctx lang]
(.getBindings ^Context ctx ^String lang))
(defn ^Value get-member
[vobj name]
(.getMember ^Value vobj ^String name))
(defn ^Value invoke
[vobj & params]
(.execute ^Value vobj (into-array Object params)))
(defn ^Value invoke-member
[vobj name & params]
(let [params (into-array Object params)]
(.invokeMember ^Value vobj ^String name params)))
(defn ^Value set-member!
[vobj name obj]
(.putMember ^Value vobj ^String name ^Object obj)
vobj)
(defn close!
[ctx]
(when ctx
(.close ^Context ctx)))

4
backend/src/app/util/http.clj
View file

@ -14,7 +14,9 @@
[promesa.exec :as px]))
(def default-client
(delay (http/build-client {:executor @px/default-executor})))
(delay (http/build-client {:executor @px/default-executor
:connect-timeout 10000 ;; 10s
:follow-redirects :always})))
(defn get!
[url opts]

65
backend/src/app/util/pool.clj
View file

@ -1,65 +0,0 @@
(ns app.util.pool
(:import
java.lang.AutoCloseable
org.apache.commons.pool2.PooledObject
org.apache.commons.pool2.PooledObjectFactory
org.apache.commons.pool2.impl.GenericObjectPool
org.apache.commons.pool2.impl.DefaultPooledObject
org.apache.commons.pool2.impl.BaseGenericObjectPool))
(def noop (constantly true))
(deftype CloseableWrapper [obj pool]
clojure.lang.IDeref
(deref [_] obj)
AutoCloseable
(close [_]
(.returnObject ^GenericObjectPool pool obj)))
(defn create
[{:keys [create destroy validate activate passivate max-idle max-total min-idle]
:or {destroy noop
validate noop
activate noop
passivate noop
max-idle 10
max-total 10
min-idle 0}}]
(let [object-factory
(proxy [PooledObjectFactory] []
(makeObject [] (DefaultPooledObject. (create)))
(destroyObject [^PooledObject o] (destroy (.getObject o)))
(validateObject [^PooledObject o] (validate (.getObject o)))
(activateObject [^PooledObject o] (activate (.getObject o)))
(passivateObject [^PooledObject o] (passivate (.getObject o))))
config
(doto (org.apache.commons.pool2.impl.GenericObjectPoolConfig.)
(.setMaxTotal max-total)
(.setMaxIdle max-idle)
(.setMinIdle min-idle)
(.setBlockWhenExhausted true))]
(GenericObjectPool. object-factory config)))
(defn borrow
[^GenericObjectPool pool]
(.borrowObject pool))
(defn return
[^GenericObjectPool pool object]
(.returnObject pool object))
(defn acquire
[pool]
(let [obj (borrow pool)]
(CloseableWrapper. obj pool)))
(defn clear!
"Clear idle objects in pool."
[pool]
(.clear ^GenericObjectPool pool))
(defn close!
[^BaseGenericObjectPool pool]
(.close pool))

180
backend/src/app/util/time.clj
View file

@ -5,18 +5,20 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
;; Copyright (c) 2020-2021 UXBOX Labs SL
(ns app.util.time
(:require
[app.common.exceptions :as ex]
[clojure.spec.alpha :as s]
[cognitect.transit :as t])
[cuerdas.core :as str])
(:import
java.time.Instant
java.time.OffsetDateTime
java.time.Duration
java.util.Date
java.time.ZonedDateTime
java.time.ZoneId
java.time.format.DateTimeFormatter
java.time.temporal.TemporalAmount
org.apache.logging.log4j.core.util.CronExpression))
@ -24,39 +26,16 @@
;; Instant & Duration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn from-string
[s]
{:pre [(string? s)]}
(Instant/parse s))
(defn instant?
[v]
(instance? Instant v))
(defn is-after?
[da db]
(.isAfter ^Instant da ^Instant db))
(defn is-before?
[da db]
(.isBefore ^Instant da ^Instant db))
(defn plus
[d ta]
(.plus d ^TemporalAmount ta))
(defn minus
[d ta]
(.minus d ^TemporalAmount ta))
;; --- DURATION
(defn- obj->duration
[{:keys [days minutes seconds hours nanos millis]}]
(cond-> (Duration/ofMillis (if (int? millis) ^long millis 0))
(int? days) (.plusDays ^long days)
(int? hours) (.plusHours ^long hours)
(int? days) (.plusDays ^long days)
(int? hours) (.plusHours ^long hours)
(int? minutes) (.plusMinutes ^long minutes)
(int? seconds) (.plusSeconds ^long seconds)
(int? nanos) (.plusNanos ^long nanos)))
(int? nanos) (.plusNanos ^long nanos)))
(defn duration?
[v]
@ -77,40 +56,10 @@
:else
(obj->duration ms-or-obj)))
(defn now
[]
(Instant/now))
(defn in-future
[v]
(plus (now) (duration v)))
(defn in-past
[v]
(minus (now) (duration v)))
(defn duration-between
[t1 t2]
(Duration/between t1 t2))
(defn instant
[ms]
(Instant/ofEpochMilli ms))
(defn parse-duration
[s]
(Duration/parse s))
(extend-protocol clojure.core/Inst
java.time.Duration
(inst-ms* [v] (.toMillis ^Duration v)))
(defmethod print-method Duration
[mv ^java.io.Writer writer]
(.write writer (str "#app/duration \"" (subs (str mv) 2) "\"")))
(defmethod print-dup Duration [o w]
(print-method o w))
(letfn [(conformer [v]
(cond
@ -128,6 +77,80 @@
(subs (str v) 2))]
(s/def ::duration (s/conformer conformer unformer)))
(extend-protocol clojure.core/Inst
java.time.Duration
(inst-ms* [v] (.toMillis ^Duration v)))
(defmethod print-method Duration
[mv ^java.io.Writer writer]
(.write writer (str "#app/duration \"" (str/lower (subs (str mv) 2)) "\"")))
(defmethod print-dup Duration [o w]
(print-method o w))
;; --- INSTANT
(defn instant
([s]
(if (int? s)
(Instant/ofEpochMilli s)
(Instant/parse s)))
([s fmt]
(case fmt
:rfc1123 (Instant/from (.parse DateTimeFormatter/RFC_1123_DATE_TIME ^String s))
:iso (Instant/from (.parse DateTimeFormatter/ISO_INSTANT ^String s))
:iso8601 (Instant/from (.parse DateTimeFormatter/ISO_INSTANT ^String s)))))
(defn instant?
[v]
(instance? Instant v))
(defn is-after?
[da db]
(.isAfter ^Instant da ^Instant db))
(defn is-before?
[da db]
(.isBefore ^Instant da ^Instant db))
(defn plus
[d ta]
(.plus d ^TemporalAmount (duration ta)))
(defn minus
[d ta]
(.minus d ^TemporalAmount (duration ta)))
(defn now
[]
(Instant/now))
(defn in-future
[v]
(plus (now) (duration v)))
(defn in-past
[v]
(minus (now) (duration v)))
(defn instant->zoned-date-time
[v]
(ZonedDateTime/ofInstant v (ZoneId/of "UTC")))
(defn format-instant
([v] (.format DateTimeFormatter/ISO_INSTANT ^Instant v))
([v fmt]
(case fmt
:iso (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
:rfc1123 (.format DateTimeFormatter/RFC_1123_DATE_TIME
^ZonedDateTime (instant->zoned-date-time v)))))
(defmethod print-method Instant
[mv ^java.io.Writer writer]
(.write writer (str "#app/instant \"" (format-instant mv) "\"")))
(defmethod print-dup Instant [o w]
(print-method o w))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cron Expression
@ -246,40 +269,3 @@
(defmethod print-dup CronExpression
[o w]
(print-ctor o (fn [o w] (print-dup (.toString ^CronExpression o) w)) w))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Serialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare from-string)
(def ^:private instant-write-handler
(t/write-handler
(constantly "m")
(fn [v] (str (.toEpochMilli ^Instant v)))))
(def ^:private offset-datetime-write-handler
(t/write-handler
(constantly "m")
(fn [v] (str (.toEpochMilli (.toInstant ^OffsetDateTime v))))))
(def ^:private read-handler
(t/read-handler
(fn [v] (-> (Long/parseLong v)
(Instant/ofEpochMilli)))))
(def +read-handlers+
{"m" read-handler})
(def +write-handlers+
{Instant instant-write-handler
OffsetDateTime offset-datetime-write-handler})
(defmethod print-method Instant
[mv ^java.io.Writer writer]
(.write writer (str "#app/instant \"" (.toString ^Instant mv) "\"")))
(defmethod print-dup Instant [o w]
(print-method o w))

51
backend/src/app/util/transit.clj
View file

@ -11,16 +11,17 @@
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.util.time :as dt]
[cognitect.transit :as t]
[linked.core :as lk])
(:import
linked.set.LinkedSet
app.common.geom.matrix.Matrix
app.common.geom.point.Point
java.io.ByteArrayInputStream
java.io.ByteArrayOutputStream
java.io.File
app.common.geom.point.Point
app.common.geom.matrix.Matrix))
java.time.Instant
java.time.OffsetDateTime
linked.set.LinkedSet))
;; --- Handlers
@ -29,6 +30,8 @@
(constantly "file")
(fn [v] (str v))))
;; --- GEOM
(def point-write-handler
(t/write-handler
(constantly "point")
@ -45,6 +48,8 @@
(def matrix-read-handler
(t/read-handler gmt/map->Matrix))
;; --- Ordered Set
(def ordered-set-write-handler
(t/write-handler
(constantly "ordered-set")
@ -53,18 +58,38 @@
(def ordered-set-read-handler
(t/read-handler #(into (lk/set) %)))
;; --- TIME
(def ^:private instant-read-handler
(t/read-handler
(fn [v] (-> (Long/parseLong v)
(Instant/ofEpochMilli)))))
(def ^:private instant-write-handler
(t/write-handler
(constantly "m")
(fn [v] (str (.toEpochMilli ^Instant v)))))
(def ^:private offset-datetime-write-handler
(t/write-handler
(constantly "m")
(fn [v] (str (.toEpochMilli (.toInstant ^OffsetDateTime v))))))
(def +read-handlers+
(assoc dt/+read-handlers+
"matrix" matrix-read-handler
"ordered-set" ordered-set-read-handler
"point" point-read-handler))
{"matrix" matrix-read-handler
"ordered-set" ordered-set-read-handler
"point" point-read-handler
"m" instant-read-handler
"instant" instant-read-handler})
(def +write-handlers+
(assoc dt/+write-handlers+
File file-write-handler
LinkedSet ordered-set-write-handler
Matrix matrix-write-handler
Point point-write-handler))
{File file-write-handler
LinkedSet ordered-set-write-handler
Matrix matrix-write-handler
Point point-write-handler
Instant instant-write-handler
OffsetDateTime offset-datetime-write-handler})
;; --- Low-Level Api

2
backend/src/data_readers.clj
View file

@ -1,3 +1,3 @@
{app/instant app.util.time/from-string
{app/instant app.util.time/instant
app/cron app.util.time/cron
app/duration app.util.time/duration}

92
backend/tests/app/tests/helpers.clj
View file

@ -52,8 +52,10 @@
:app.http/server
:app.http/router
:app.notifications/handler
:app.http.auth/google
:app.http.auth/gitlab
:app.http.oauth/google
:app.http.oauth/gitlab
:app.http.oauth/github
:app.http.oauth/all
:app.worker/scheduler
:app.worker/worker)
(d/deep-merge
@ -143,6 +145,10 @@
:name (str "file" i)}
params))))
(defn mark-file-deleted*
([params] (mark-file-deleted* *pool* params))
([conn {:keys [id] :as params}]
(#'files/mark-file-deleted conn {:id id})))
(defn create-team*
([i params] (create-team* *pool* i params))
@ -152,14 +158,26 @@
team (#'teams/create-team conn {:id id
:profile-id profile-id
:name (str "team" i)})]
(#'teams/create-team-profile conn
{:team-id id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true})
(#'teams/create-team-role conn
{:team-id id
:profile-id profile-id
:role :owner})
team)))
(defn create-file-media-object*
([params] (create-file-media-object* *pool* params))
([conn {:keys [name width height mtype file-id is-local media-id]
:or {name "sample" width 100 height 100 mtype "image/svg+xml" is-local true}}]
(db/insert! conn :file-media-object
{:id (uuid/next)
:file-id file-id
:is-local is-local
:name name
:media-id media-id
:width width
:height height
:mtype mtype})))
(defn link-file-to-library*
([params] (link-file-to-library* *pool* params))
([conn {:keys [file-id library-id] :as params}]
@ -181,37 +199,39 @@
:created-at (or created-at (dt/now))
:content (db/tjson {})}))
(defn create-team-role*
([params] (create-team-role* *pool* params))
([conn {:keys [team-id profile-id role] :or {role :owner}}]
(#'teams/create-team-role conn {:team-id team-id
:profile-id profile-id
:role role})))
(defn create-team-permission*
([params] (create-team-permission* *pool* params))
([conn {:keys [team-id profile-id is-owner is-admin can-edit]
:or {is-owner true is-admin true can-edit true}}]
(db/insert! conn :team-profile-rel {:team-id team-id
:profile-id profile-id
:is-owner is-owner
:is-admin is-admin
:can-edit can-edit})))
(defn create-project-role*
([params] (create-project-role* *pool* params))
([conn {:keys [project-id profile-id role] :or {role :owner}}]
(#'projects/create-project-role conn {:project-id project-id
:profile-id profile-id
:role role})))
(defn create-project-permission*
([params] (create-project-permission* *pool* params))
([conn {:keys [project-id profile-id is-owner is-admin can-edit]
:or {is-owner true is-admin true can-edit true}}]
(db/insert! conn :project-profile-rel {:project-id project-id
:profile-id profile-id
:is-owner is-owner
:is-admin is-admin
:can-edit can-edit})))
(defn create-file-permission*
([params] (create-file-permission* *pool* params))
([conn {:keys [file-id profile-id is-owner is-admin can-edit]
:or {is-owner true is-admin true can-edit true}}]
(db/insert! conn :project-profile-rel {:file-id file-id
:profile-id profile-id
:is-owner is-owner
:is-admin is-admin
:can-edit can-edit})))
(defn create-file-role*
([params] (create-file-role* *pool* params))
([conn {:keys [file-id profile-id role] :or {role :owner}}]
(#'files/create-file-role conn {:file-id file-id
:profile-id profile-id
:role role})))
(defn update-file*
([params] (update-file* *pool* params))
([conn {:keys [file-id changes session-id profile-id revn]
:or {session-id (uuid/next) revn 0}}]
(let [file (db/get-by-id conn :file file-id)
msgbus (:app.msgbus/msgbus *system*)]
(#'files/update-file {:conn conn :msgbus msgbus}
{:file file
:revn revn
:changes changes
:session-id session-id
:profile-id profile-id}))))
;; --- RPC HELPERS

611
backend/tests/app/tests/test_services_management.clj Normal file
View file

@ -0,0 +1,611 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2021 UXBOX Labs SL
(ns app.tests.test-services-management
(:require
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
[app.storage :as sto]
[app.tests.helpers :as th]
[clojure.test :as t]
[buddy.core.bytes :as b]
[datoteka.core :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest duplicate-file
(let [storage (:app.storage/storage th/*system*)
sobject (sto/put-object storage {:content (sto/content "content")
:content-type "text/plain"
:other "data"})
profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project)
:is-shared true})
libl (th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
mobj (th/create-file-media-object* {:file-id (:id file1)
:is-local false
:media-id (:id sobject)})]
(th/update-file*
{:file-id (:id file1)
:profile-id (:id profile)
:changes [{:type :add-media
:object (select-keys mobj [:id :width :height :mtype :name])}]})
(let [data {::th/type :duplicate-file
:profile-id (:id profile)
:file-id (:id file1)
:name "file 1 (copy)"}
out (th/mutation! data)]
;; (th/print-result! out)
;; Check tha tresult is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
;; Check that the returned result is a file but has different id
;; and different name.
(t/is (= "file 1 (copy)" (:name result)))
(t/is (not= (:id file1) (:id result)))
;; Check that the new file has a correct file library relation
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id result)})]
(t/is (= 1 (count rows)))
(t/is (= (:id file2) (:library-file-id item))))
;; Check that the new file has a correct file media objects
(let [[item :as rows] (db/query th/*pool* :file-media-object {:file-id (:id result)})]
(t/is (= 1 (count rows)))
;; Check that both items have different ids
(t/is (not= (:id item) (:id mobj)))
;; check that both file-media-objects points to the same storage object.
(t/is (= (:media-id item) (:media-id mobj)))
(t/is (= (:media-id item) (:id sobject)))
;; Check if media correctly contains the new file-media-object id
(t/is (contains? (get-in result [:data :media]) (:id item)))
;; And does not contains the old one
(t/is (not (contains? (get-in result [:data :media]) (:id mobj)))))
;; Check the total number of files
(let [rows (db/query th/*pool* :file {:project-id (:id project)})]
(t/is (= 3 (count rows))))
))))
(t/deftest duplicate-file-with-deleted-rels
(let [storage (:app.storage/storage th/*system*)
sobject (sto/put-object storage {:content (sto/content "content")
:content-type "text/plain"
:other "data"})
profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project)
:is-shared true})
libl (th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
mobj (th/create-file-media-object* {:file-id (:id file1)
:is-local false
:media-id (:id sobject)})
_ (th/mark-file-deleted* {:id (:id file2)})
_ (sto/del-object storage (:id sobject))]
(th/update-file*
{:file-id (:id file1)
:profile-id (:id profile)
:changes [{:type :add-media
:object (select-keys mobj [:id :width :height :mtype :name])}]})
(let [data {::th/type :duplicate-file
:profile-id (:id profile)
:file-id (:id file1)
:name "file 1 (copy)"}
out (th/mutation! data)]
;; (th/print-result! out)
;; Check tha tresult is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
;; Check that the returned result is a file but has different id
;; and different name.
(t/is (= "file 1 (copy)" (:name result)))
(t/is (not= (:id file1) (:id result)))
;; Check that the deleted library is not duplicated
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id result)})]
(t/is (= 0 (count rows))))
;; Check that the new file has no media objects
(let [[item :as rows] (db/query th/*pool* :file-media-object {:file-id (:id result)})]
(t/is (= 0 (count rows))))
;; Check the total number of files
(let [rows (db/query th/*pool* :file {:project-id (:id project)})]
(t/is (= 3 (count rows))))
))))
(t/deftest duplicate-project
(let [storage (:app.storage/storage th/*system*)
sobject (sto/put-object storage {:content (sto/content "content")
:content-type "text/plain"
:other "data"})
profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project)
:is-shared true})
libl (th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
mobj (th/create-file-media-object* {:file-id (:id file1)
:is-local false
:media-id (:id sobject)})]
(th/update-file*
{:file-id (:id file1)
:profile-id (:id profile)
:changes [{:type :add-media
:object (select-keys mobj [:id :width :height :mtype :name])}]})
(let [data {::th/type :duplicate-project
:profile-id (:id profile)
:project-id (:id project)
:name "project 1 (copy)"}
out (th/mutation! data)]
;; Check tha tresult is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
;; Check that they are the same project but different id and name
(t/is (= "project 1 (copy)" (:name result)))
(t/is (not= (:id project) (:id result)))
;; Check the total number of projects (previously is 2, now is 3)
(let [rows (db/query th/*pool* :project {:team-id (:default-team-id profile)})]
(t/is (= 3 (count rows))))
;; Check that the new project has the same files
(let [p1-files (db/query th/*pool* :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (db/query th/*pool* :file
{:project-id (:id result)}
{:order-by [:name]})]
(t/is (= (count p1-files)
(count p2-files)))
;; check that the both files are equivalent
(doseq [[fa fb] (map vector p1-files p2-files)]
(t/is (not= (:id fa) (:id fb)))
(t/is (= (:name fa) (:name fb)))
(when (= (:id fa) (:id file1))
(t/is (false? (b/equals? (:data fa)
(:data fb)))))
(when (= (:id fa) (:id file2))
(t/is (false? (b/equals? (:data fa)
(:data fb))))))
)))))
(t/deftest duplicate-project-with-deleted-files
(let [storage (:app.storage/storage th/*system*)
sobject (sto/put-object storage {:content (sto/content "content")
:content-type "text/plain"
:other "data"})
profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project)
:is-shared true})
libl (th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
mobj (th/create-file-media-object* {:file-id (:id file1)
:is-local false
:media-id (:id sobject)})]
(th/update-file*
{:file-id (:id file1)
:profile-id (:id profile)
:changes [{:type :add-media
:object (select-keys mobj [:id :width :height :mtype :name])}]})
(th/mark-file-deleted* {:id (:id file1)})
(let [data {::th/type :duplicate-project
:profile-id (:id profile)
:project-id (:id project)
:name "project 1 (copy)"}
out (th/mutation! data)]
;; Check tha tresult is correct
(t/is (nil? (:error out)))
(let [result (:result out)]
;; Check that they are the same project but different id and name
(t/is (= "project 1 (copy)" (:name result)))
(t/is (not= (:id project) (:id result)))
;; Check the total number of projects (previously is 2, now is 3)
(let [rows (db/query th/*pool* :project {:team-id (:default-team-id profile)})]
(t/is (= 3 (count rows))))
;; Check that the new project has only the second file
(let [p1-files (db/query th/*pool* :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (db/query th/*pool* :file
{:project-id (:id result)}
{:order-by [:name]})]
(t/is (= (count (rest p1-files))
(count p2-files)))
;; check that the both files are equivalent
(doseq [[fa fb] (map vector (rest p1-files) p2-files)]
(t/is (not= (:id fa) (:id fb)))
(t/is (= (:name fa) (:name fb)))
(when (= (:id fa) (:id file1))
(t/is (false? (b/equals? (:data fa)
(:data fb)))))
(when (= (:id fa) (:id file2))
(t/is (false? (b/equals? (:data fa)
(:data fb))))))
)))))
(t/deftest move-file-on-same-team
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project1 (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
project2 (th/create-project* 2 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project1)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project1)
:is-shared true})]
(th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
;; Try to move to same project
(let [data {::th/type :move-files
:profile-id (:id profile)
:project-id (:id project1)
:ids #{(:id file1)}}
out (th/mutation! data)
error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :cant-move-to-same-project)))
;; initially project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; initially project2 should be empty
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; move a file1 to project2 (in the same team)
(let [data {::th/type :move-files
:profile-id (:id profile)
:project-id (:id project2)
:ids #{(:id file1)}}
out (th/mutation! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
;; project1 now should contain 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(t/is (= 1 (count rows))))
;; project2 now should contain 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 1 (count rows))))
;; file1 should be still linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; should be no libraries on file2
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows))))
)))
;; TODO: move a library to other team
(t/deftest move-file-to-other-team
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project1 (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
project2 (th/create-project* 2 {:team-id (:id team)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project1)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project1)
:is-shared true})
file3 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:id project1)
:is-shared true})]
(th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
(th/link-file-to-library* {:file-id (:id file2)
:library-id (:id file3)})
;; --- initial data checks
;; the project1 should have 3 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(t/is (= 3 (count rows))))
;; should be no files on project2
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; the file1 should be linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; the file2 should be linked to file3
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file2)))
(t/is (= (:library-file-id item) (:id file3))))
;; should be no libraries on file3
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file3)})]
(t/is (= 0 (count rows))))
;; move to other project in other team
(let [data {::th/type :move-files
:profile-id (:id profile)
:project-id (:id project2)
:ids #{(:id file1)}}
out (th/mutation! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
;; project1 now should have 2 file
(let [[item1 item2 :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
;; (clojure.pprint/pprint rows)
(t/is (= 2 (count rows)))
(t/is (= (:id item1) (:id file2))))
;; project2 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file1))))
;; the moved file1 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(t/is (zero? (count rows))))
;; the file2 should still be linked to file3
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file2)))
(t/is (= (:library-file-id item) (:id file3))))
)))
(t/deftest move-library-to-other-team
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project1 (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
project2 (th/create-project* 2 {:team-id (:id team)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project1)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project1)
:is-shared true})]
(th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
;; --- initial data checks
;; the project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; should be no files on project2
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; the file1 should be linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; should be no libraries on file2
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows))))
;; move the library to other project
(let [data {::th/type :move-files
:profile-id (:id profile)
:project-id (:id project2)
:ids #{(:id file2)}}
out (th/mutation! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
;; project1 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file1))))
;; project2 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file2))))
;; the file1 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(t/is (zero? (count rows))))
;; the file2 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (zero? (count rows))))
)))
(t/deftest move-project
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project1 (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
project2 (th/create-project* 2 {:team-id (:default-team-id profile)
:profile-id (:id profile)})
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project1)})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project1)
:is-shared true})
file3 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:id project2)
:is-shared true})]
(th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file2)})
(th/link-file-to-library* {:file-id (:id file1)
:library-id (:id file3)})
;; --- initial data checks
;; the project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; the project2 should have 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 1 (count rows))))
;; the file1 should be linked to file2 and file3
(let [[item1 item2 :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)}
{:order-by [:created-at]})]
(t/is (= 2 (count rows)))
(t/is (= (:file-id item1) (:id file1)))
(t/is (= (:library-file-id item1) (:id file2)))
(t/is (= (:file-id item2) (:id file1)))
(t/is (= (:library-file-id item2) (:id file3))))
;; the file2 should not be linked to any file
(let [[rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows))))
;; the file3 should not be linked to any file
(let [[rows] (db/query th/*pool* :file-library-rel {:file-id (:id file3)})]
(t/is (= 0 (count rows))))
;; move project1 to other team
;; TODO: correct team change of project
(let [data {::th/type :move-project
:profile-id (:id profile)
:project-id (:id project1)
:team-id (:id team)}
out (th/mutation! data)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
;; project1 now should still have 2 files
(let [[item1 item2 :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
;; (clojure.pprint/pprint rows)
(t/is (= 2 (count rows)))
(t/is (= (:id item1) (:id file1)))
(t/is (= (:id item2) (:id file2))))
;; project2 now should still have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file3))))
;; the file1 should be linked to file2 but not file3
(let [[item1 :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)}
{:order-by [:created-at]})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item1) (:id file1)))
(t/is (= (:library-file-id item1) (:id file2))))
)))

24
backend/tests/app/tests/test_services_projects.clj
View file

@ -24,7 +24,7 @@
team (th/create-team* 1 {:profile-id (:id profile)})
project-id (uuid/next)]
;; crate project
;; create project
(let [data {::th/type :create-project
:id project-id
:profile-id (:id profile)
@ -37,7 +37,7 @@
(let [result (:result out)]
(t/is (= (:name data) (:name result)))))
;; query a list of projects
;; query the list of projects of a team
(let [data {::th/type :projects
:team-id (:id team)
:profile-id (:id profile)}
@ -50,7 +50,25 @@
(t/is project-id (get-in result [0 :id]))
(t/is (= "test project" (get-in result [0 :name])))))
;; rename project"
;; query all projects of a user
(let [data {::th/type :all-projects
:profile-id (:id profile)}
out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 2 (count result)))
(t/is (not= project-id (get-in result [0 :id])))
(t/is (= "Drafts" (get-in result [0 :name])))
(t/is (= "Default" (get-in result [0 :team-name])))
(t/is (= true (get-in result [0 :is-default-team])))
(t/is project-id (get-in result [1 :id]))
(t/is (= "test project" (get-in result [1 :name])))
(t/is (= "team1" (get-in result [1 :team-name])))
(t/is (= false (get-in result [1 :is-default-team])))))
;; rename project
(let [data {::th/type :rename-project
:id project-id
:name "renamed project"

24
backend/tests/app/tests/test_svgc.clj
View file

@ -1,24 +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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2021 UXBOX Labs SL
(ns app.tests.test-svgc
(:require
[app.tests.helpers :as th]
[clojure.java.io :as io]
[clojure.test :as t]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/deftest run-svgc-over-sample-file
(let [svgc (:app.svgparse/svgc th/*system*)
data (slurp (io/resource "app/tests/_files/sample1.svg"))
res (svgc data)]
(t/is (string? res))
(t/is (= 2533 (count res)))))

13
common/app/common/attrs.cljc
View file

@ -7,7 +7,8 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.common.attrs)
(ns app.common.attrs
(:refer-clojure :exclude [merge]))
;; Extract some attributes of a list of shapes.
;; For each attribute, if the value is the same in all shapes,
@ -48,7 +49,6 @@
(loop [attr (first attrs)
attrs (rest attrs)
result (transient {})]
(if attr
(let [value
(loop [curr (first objs)
@ -75,3 +75,12 @@
(persistent! result)))))
(defn merge
"Attrs specific merge function."
[obj attrs]
(reduce-kv (fn [obj k v]
(if (nil? v)
(dissoc obj k)
(assoc obj k v)))
obj
attrs))

93
common/app/common/data.cljc
View file

@ -6,7 +6,7 @@
(ns app.common.data
"Data manipulation and query helper functions."
(:refer-clojure :exclude [concat read-string hash-map merge])
(:refer-clojure :exclude [concat read-string hash-map merge name])
#?(:cljs
(:require-macros [app.common.data]))
(:require
@ -42,7 +42,6 @@
([a b & rest]
(reduce deep-merge a (cons b rest))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Structures Manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -70,14 +69,14 @@
(defn enumerate
([items] (enumerate items 0))
([items start]
(loop [idx start
(loop [idx start
items items
res []]
res (transient [])]
(if (empty? items)
res
(persistent! res)
(recur (inc idx)
(rest items)
(conj res [idx (first items)]))))))
(conj! res [idx (first items)]))))))
(defn seek
([pred coll]
@ -132,8 +131,9 @@
"Return a map without the keys provided
in the `keys` parameter."
[data keys]
(persistent!
(reduce #(dissoc! %1 %2) (transient data) keys)))
(when data
(persistent!
(reduce #(dissoc! %1 %2) (transient data) keys))))
(defn remove-at-index
[v index]
@ -146,8 +146,10 @@
(defn mapm
"Map over the values of a map"
[mfn coll]
(into {} (map (fn [[key val]] [key (mfn key val)]) coll)))
([mfn]
(map (fn [[key val]] [key (mfn key val)])))
([mfn coll]
(into {} (mapm mfn) coll)))
(defn filterm
"Filter values of a map that satisfy a predicate"
@ -302,6 +304,14 @@
default
v))))
(defn num-string? [v]
;; https://stackoverflow.com/questions/175739/built-in-way-in-javascript-to-check-if-a-string-is-a-valid-number
#?(:cljs (and (string? v)
(not (js/isNaN v))
(not (js/isNaN (parse-double v))))
:clj (not= (parse-double v :nan) :nan)))
(defn read-string
[v]
(r/read-string v))
@ -336,10 +346,12 @@
(defn check-num
"Function that checks if a number is nil or nan. Will return 0 when not
valid and the number otherwise."
[v]
(if (or (not v)
(not (mth/finite? v))
(mth/nan? v)) 0 v))
([v]
(check-num v 0))
([v default]
(if (or (not v)
(not (mth/finite? v))
(mth/nan? v)) default v)))
(defmacro export
@ -350,7 +362,7 @@
;; Code for ClojureScript
(let [mdata (aapi/resolve &env v)
arglists (second (get-in mdata [:meta :arglists]))
sym (symbol (name v))
sym (symbol (core/name v))
andsym (symbol "&")
procarg #(if (= % andsym) % (gensym "param"))]
(if (pos? (count arglists))
@ -382,3 +394,54 @@
(defn any-key? [element & rest]
(some #(contains? element %) rest))
(defn name
"Improved version of name that won't fail if the input is not a keyword"
([maybe-keyword] (name maybe-keyword nil))
([maybe-keyword default-value]
(cond
(keyword? maybe-keyword)
(core/name maybe-keyword)
(nil? maybe-keyword) default-value
:else
(or default-value
(str maybe-keyword)))))
(defn with-next
"Given a collectin will return a new collection where each element
is paried with the next item in the collection
(with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]"
[coll]
(map vector
coll
(concat [] (rest coll) [nil])))
(defn with-prev
"Given a collectin will return a new collection where each element
is paried with the previous item in the collection
(with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]"
[coll]
(map vector
coll
(concat [nil] coll)))
(defn with-prev-next
"Given a collection will return a new collection where every item is paired
with the previous and the next item of a collection
(with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]"
[coll]
(map vector
coll
(concat [nil] coll)
(concat [] (rest coll) [nil])))
(defn prefix-keyword
"Given a keyword and a prefix will return a new keyword with the prefix attached
(prefix-keyword \"prefix\" :test) => :prefix-test"
[prefix kw]
(let [prefix (if (keyword? prefix) (name prefix) prefix)
kw (if (keyword? kw) (name kw) kw)]
(keyword (str prefix kw))))

16
common/app/common/geom/matrix.cljc
View file

@ -11,6 +11,8 @@
(:require
#?(:cljs [cljs.pprint :as pp]
:clj [clojure.pprint :as pp])
[cuerdas.core :as str]
[app.common.data :as d]
[app.common.math :as mth]
[app.common.geom.point :as gpt]))
@ -21,6 +23,13 @@
(toString [_]
(str "matrix(" a "," b "," c "," d "," e "," f ")")))
(defn matrix
"Create a new matrix instance."
([]
(Matrix. 1 0 0 1 0 0))
([a b c d e f]
(Matrix. a b c d e f)))
(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}]
@ -46,13 +55,6 @@
[v]
(instance? Matrix v))
(defn matrix
"Create a new matrix instance."
([]
(Matrix. 1 0 0 1 0 0))
([a b c d e f]
(Matrix. a b c d e f)))
(def base (matrix))
(defn base?

5
common/app/common/geom/point.cljc
View file

@ -204,6 +204,11 @@
(defn to-vec [p1 p2]
(subtract p2 p1))
(defn scale [v scalar]
(-> v
(update :x * scalar)
(update :y * scalar)))
(defn dot [{x1 :x y1 :y} {x2 :x y2 :y}]
(+ (* x1 x2) (* y1 y2)))

48
common/app/common/geom/shapes.cljc
View file

@ -10,12 +10,14 @@
(ns app.common.geom.shapes
(:require
[app.common.data :as d]
[app.common.math :as mth]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr]
[app.common.geom.shapes.intersect :as gin]
[app.common.spec :as us]))
;; --- Relative Movement
@ -148,37 +150,14 @@
(update-in [:selrect :x2] - x)
(update-in [:selrect :y2] - y)
(d/update-when :points #(map move-point %))
(d/update-when :points #(mapv move-point %))
(cond-> (= :path type)
(d/update-when :content #(map move-segment %))))))
(d/update-when :content #(mapv move-segment %))))))
;; --- Helpers
(defn contained-in?
"Check if a shape is contained in the
provided selection rect."
[shape selrect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} selrect
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (:selrect shape)]
(and (neg? (- sy1 ry1))
(neg? (- sx1 rx1))
(pos? (- sy2 ry2))
(pos? (- sx2 rx2)))))
;; TODO: This not will work for rotated shapes
(defn overlaps?
"Check if a shape overlaps with provided selection rect."
[shape rect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/rect->selrect rect)
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/points->selrect (:points shape))]
(and (< rx1 sx2)
(> rx2 sx1)
(< ry1 sy2)
(> ry2 sy1))))
(defn fully-contained?
"Checks if one rect is fully inside the other"
[rect other]
@ -187,20 +166,6 @@
(<= (:y1 rect) (:y1 other))
(>= (:y2 rect) (:y2 other))))
(defn has-point?
[shape position]
(let [{:keys [x y]} position
selrect {:x1 (- x 5)
:y1 (- y 5)
:x2 (+ x 5)
:y2 (+ y 5)
:x (- x 5)
:y (- y 5)
:width 10
:height 10
:type :rect}]
(overlaps? shape selrect)))
(defn pad-selrec
([selrect] (pad-selrec selrect 1))
([selrect size]
@ -281,8 +246,13 @@
(d/export gtr/transform-rect)
(d/export gtr/update-group-selrect)
(d/export gtr/transform-points)
(d/export gtr/calculate-adjust-matrix)
;; PATHS
(d/export gsp/content->points)
(d/export gsp/content->selrect)
(d/export gsp/transform-content)
;; Intersection
(d/export gin/overlaps?)
(d/export gin/has-point?)

296
common/app/common/geom/shapes/intersect.cljc Normal file
View file

@ -0,0 +1,296 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.common.geom.shapes.intersect
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.matrix :as gmt]
[app.common.geom.shapes.path :as gpp]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]))
(defn orientation
"Given three ordered points gives the orientation
(clockwise, counterclock or coplanar-line)"
[p1 p2 p3]
(let [{x1 :x y1 :y} p1
{x2 :x y2 :y} p2
{x3 :x y3 :y} p3
v (- (* (- y2 y1) (- x3 x2))
(* (- y3 y2) (- x2 x1)))]
(cond
(pos? v) ::clockwise
(neg? v) ::counter-clockwise
:else ::coplanar)))
(defn on-segment?
"Given three colinear points p, q, r checks if q lies on segment pr"
[{qx :x qy :y} {px :x py :y} {rx :x ry :y}]
(and (<= qx (max px rx))
(>= qx (min px rx))
(<= qy (max py ry))
(>= qy (min py ry))))
;; Based on solution described here
;; https://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/
(defn intersect-segments?
"Given two segments A<pa1,pa2> and B<pb1,pb2> defined by two points.
Checks if they intersects."
[[p1 q1] [p2 q2]]
(let [o1 (orientation p1 q1 p2)
o2 (orientation p1 q1 q2)
o3 (orientation p2 q2 p1)
o4 (orientation p2 q2 q1)]
(or
;; General case
(and (not= o1 o2) (not= o3 o4))
;; p1, q1 and p2 colinear and p2 lies on p1q1
(and (= o1 :coplanar) (on-segment? p2 p1 q1))
;; p1, q1 and q2 colinear and q2 lies on p1q1
(and (= o2 :coplanar) (on-segment? q2 p1 q1))
;; p2, q2 and p1 colinear and p1 lies on p2q2
(and (= o3 :coplanar) (on-segment? p1 p2 q2))
;; p2, q2 and p1 colinear and q1 lies on p2q2
(and (= o4 :coplanar) (on-segment? q1 p2 q2)))))
(defn points->lines
"Given a set of points for a polygon will return
the lines that define it"
([points]
(points->lines points true))
([points closed?]
(map vector
points
(-> (rest points)
(vec)
(cond-> closed?
(conj (first points)))))))
(defn intersects-lines?
"Checks if two sets of lines intersect in any point"
[lines-a lines-b]
(loop [cur-line (first lines-a)
pending (rest lines-a)]
(if-not cur-line
;; There is no line intersecting polygon b
false
;; Check if any of the segments intersect
(if (->> lines-b
(some #(intersect-segments? cur-line %)))
true
(recur (first pending) (rest pending))))))
(defn intersect-ray?
"Checks the intersection between segment qr and a ray
starting in point p with an angle of 0 degrees"
[{px :x py :y} [{x1 :x y1 :y} {x2 :x y2 :y}]]
(if (or (and (<= y1 py) (> y2 py))
(and (> y1 py) (<= y2 py)))
;; calculate the edge-ray intersect x-coord
(let [vt (/ (- py y1) (- y2 y1))
ix (+ x1 (* vt (- x2 x1)))]
(< px ix))
false))
(defn is-point-inside-evenodd?
"Check if the point P is inside the polygon defined by `points`"
[p lines]
;; Even-odd algorithm
;; Cast a ray from the point in any direction and count the intersections
;; if it's odd the point is inside the polygon
(let []
(->> lines
(filter #(intersect-ray? p %))
(count)
(odd?))))
(defn- next-windup
"Calculates the next windup number for the nonzero algorithm"
[wn {px :x py :y} [{x1 :x y1 :y} {x2 :x y2 :y}]]
(let [line-side (- (* (- x2 x1) (- py y1))
(* (- px x1) (- y2 y1)))]
(if (<= y1 py)
;; Upward crossing
(if (and (> y2 py) (> line-side 0)) (inc wn) wn)
;; Downward crossing
(if (and (<= y2 py) (< line-side 0)) (dec wn) wn))))
(defn is-point-inside-nonzero?
"Check if the point P is inside the polygon defined by `points`"
[p lines]
;; Non-zero winding number
;; Calculates the winding number
(loop [wn 0
line (first lines)
lines (rest lines)]
(if line
(let [wn (next-windup wn p line)]
(recur wn (first lines) (rest lines)))
(not= wn 0))))
;; A intersects with B
;; Three posible cases:
;; 1) A is inside of B
;; 2) B is inside of A
;; 3) A intersects B
;; 4) A is outside of B
;;
;; . check point in A is inside B => case 1 or 3 otherwise discard 1
;; . check point in B is inside A => case 2 or 3 otherwise discard 2
;; . check if intersection otherwise case 4
;;
(defn overlaps-rect-points?
"Checks if the given rect intersects with the selrect"
[rect points]
(let [rect-points (gpr/rect->points rect)
rect-lines (points->lines rect-points)
points-lines (points->lines points)]
(or (is-point-inside-evenodd? (first rect-points) points-lines)
(is-point-inside-evenodd? (first points) rect-lines)
(intersects-lines? rect-lines points-lines))))
(defn overlaps-path?
"Checks if the given rect overlaps with the path in any point"
[shape rect]
(let [rect-points (gpr/rect->points rect)
rect-lines (points->lines rect-points)
path-lines (gpp/path->lines shape)
start-point (-> shape :content (first) :params (gpt/point))]
(or (is-point-inside-nonzero? (first rect-points) path-lines)
(is-point-inside-nonzero? start-point rect-lines)
(intersects-lines? rect-lines path-lines))))
(defn is-point-inside-ellipse?
"checks if a point is inside an ellipse"
[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)]
;; Ellipse inequality formula
;; https://en.wikipedia.org/wiki/Ellipse#Shifted_ellipse
(let [v (+ (/ (mth/sq (- px cx))
(mth/sq rx))
(/ (mth/sq (- py cy))
(mth/sq ry)))]
(<= v 1))))
(defn intersects-line-ellipse?
"Checks wether 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
;; The result of this quadratic will give us a value of T that needs to be
;; between 0-1 to be in the segment
(let [a (+ (/ (mth/sq (- x2 x1))
(mth/sq rx))
(/ (mth/sq (- y2 y1))
(mth/sq ry)))
b (+ (/ (- (* 2 x1 (- x2 x1))
(* 2 cx (- x2 x1)))
(mth/sq rx))
(/ (- (* 2 y1 (- y2 y1))
(* 2 cy (- y2 y1)))
(mth/sq ry)))
c (+ (/ (+ (mth/sq x1)
(mth/sq cx)
(* -2 x1 cx))
(mth/sq rx))
(/ (+ (mth/sq y1)
(mth/sq cy)
(* -2 y1 cy))
(mth/sq ry))
-1)
;; B^2 - 4AC
determ (- (mth/sq b) (* 4 a c))]
(if (mth/almost-zero? a)
;; If a=0 we need to calculate the linear solution
(when-not (mth/almost-zero? b)
(let [t (/ (- c) b)]
(and (>= t 0) (<= t 1))))
(when (>= determ 0)
(let [t1 (/ (+ (- b) (mth/sqrt determ)) (* 2 a))
t2 (/ (- (- b) (mth/sqrt determ)) (* 2 a))]
(or (and (>= t1 0) (<= t1 1))
(and (>= t2 0) (<= t2 1))))))))
(defn intersects-lines-ellipse?
"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)]
(some (fn [[p1 p2]]
(let [p1 (gpt/transform p1 transform)
p2 (gpt/transform p2 transform)]
(intersects-line-ellipse? [p1 p2] ellipse-data))) rect-lines)))
(defn overlaps-ellipse?
"Checks if the given rect overlaps with an ellipse"
[shape rect]
(let [rect-points (gpr/rect->points rect)
rect-lines (points->lines rect-points)
{:keys [x y width height]} shape
center (gpt/point (+ x (/ width 2))
(+ y (/ height 2)))
ellipse-data {:cx (:x center)
:cy (:y center)
:rx (/ width 2)
:ry (/ height 2)
:transform (:transform-inverse shape)}]
(or (is-point-inside-evenodd? center rect-lines)
(is-point-inside-ellipse? (first rect-points) ellipse-data)
(intersects-lines-ellipse? rect-lines ellipse-data))))
(defn overlaps?
"General case to check for overlaping between shapes and a rectangle"
[shape rect]
(or (not shape)
(let [path? (= :path (:type shape))
circle? (= :circle (:type shape))]
(and (overlaps-rect-points? rect (:points shape))
(or (not path?) (overlaps-path? shape rect))
(or (not circle?) (overlaps-ellipse? shape rect))))))
(defn has-point?
"Check if the shape contains a point"
[shape point]
(let [lines (points->lines (:points shape))]
;; TODO: Will only work for simple shapes
(is-point-inside-evenodd? point lines)))

53
common/app/common/geom/shapes/path.cljc
View file

@ -161,3 +161,56 @@
(when closed?
[{:command :close-path}])))))
(defonce num-segments 10)
(defn curve->lines
"Transform the bezier curve given by the parameters into a series of straight lines
defined by the constant num-segments"
[start end h1 h2]
(let [offset (/ 1 num-segments)
tp (fn [t] (curve-values start end h1 h2 t))]
(loop [from 0
result []]
(let [to (min 1 (+ from offset))
line [(tp from) (tp to)]
result (conj result line)]
(if (>= to 1)
result
(recur to result))))))
(defn path->lines
"Given a path returns a list of lines that approximate the path"
[shape]
(loop [command (first (:content shape))
pending (rest (:content shape))
result []
last-start nil
prev-point nil]
(if-let [{:keys [command params]} command]
(let [point (if (= :close-path command)
last-start
(gpt/point params))
result (case command
:line-to (conj result [prev-point point])
:curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
h2 (gpt/point (:c2x params) (:c2y params))]
(into result (curve->lines prev-point point h1 h2)))
:move-to (cond-> result
last-start (conj [prev-point last-start]))
result)
last-start (if (= :move-to command)
point
last-start)
]
(recur (first pending)
(rest pending)
result
last-start
point))
(conj result [prev-point last-start]))))

94
common/app/common/geom/shapes/transforms.cljc
View file

@ -139,11 +139,15 @@
(defn- calculate-height
"Calculates the height of a paralelogram given by the points"
[[p1 _ p3 p4]]
(let [v1 (gpt/to-vec p3 p4)
v2 (gpt/to-vec p4 p1)
angle (gpt/angle-with-other v1 v2)]
(* (gpt/length v2) (mth/sin (mth/radians angle)))))
[[p1 _ _ p4]]
(-> (gpt/to-vec p4 p1)
(gpt/length)))
(defn- calculate-width
"Calculates the width of a paralelogram given by the points"
[[p1 p2 _ _]]
(-> (gpt/to-vec p1 p2)
(gpt/length)))
(defn- calculate-rotation
"Calculates the rotation between two shapes given the resize vector direction"
@ -173,44 +177,49 @@
"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`.
This is compose of three transformations: skew, resize and rotation"
[points-temp points-rec flip-x flip-y]
(let [center (gco/center-points points-temp)
([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)
stretch-matrix (gmt/matrix)
stretch-matrix (gmt/matrix)
skew-angle (calculate-skew-angle points-temp)
skew-angle (calculate-skew-angle points-temp)
;; When one of the axis is flipped we have to reverse the skew
;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
skew-angle (if (and (or flip-x flip-y)
(not (and flip-x flip-y))) (- skew-angle) skew-angle )
skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
;; When one of the axis is flipped we have to reverse the skew
;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
skew-angle (if (and (or flip-x flip-y)
(not (and flip-x flip-y))) (- skew-angle) skew-angle )
skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
h1 (max 1 (calculate-height points-temp))
h2 (max 1 (calculate-height (transform-points points-rec center stretch-matrix)))
h3 (if-not (mth/almost-zero? h2) (/ h1 h2) 1)
h3 (if (mth/nan? h3) 1 h3)
h1 (max 1 (calculate-height points-temp))
h2 (max 1 (calculate-height (transform-points points-rec center stretch-matrix)))
h3 (if-not (mth/almost-zero? h2) (/ h1 h2) 1)
h3 (if (mth/nan? h3) 1 h3)
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3)))
w1 (max 1 (calculate-width points-temp))
w2 (max 1 (calculate-width (transform-points points-rec center stretch-matrix)))
w3 (if-not (mth/almost-zero? w2) (/ w1 w2) 1)
w3 (if (mth/nan? w3) 1 w3)
rotation-angle (calculate-rotation
center
(transform-points points-rec (gco/center-points points-rec) stretch-matrix)
points-temp
flip-x
flip-y)
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point w3 h3)))
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
rotation-angle (calculate-rotation
center
(transform-points points-rec (gco/center-points points-rec) stretch-matrix)
points-temp
flip-x
flip-y)
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 (/ 1 h3)))
(gmt/skew (- skew-angle) 0)
(gmt/rotate (- rotation-angle)))]
[stretch-matrix stretch-matrix-inverse]))
;; 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 stretch-matrix-inverse rotation-angle])))
(defn apply-transform
"Given a new set of points transformed, set up the rectangle so it keeps
@ -276,6 +285,24 @@
(dissoc :modifiers)))
shape)))
(defn update-group-viewbox
"Updates the viewbox for groups imported from SVG's"
[{:keys [selrect svg-viewbox] :as group} new-selrect]
(let [;; Gets deltas for the selrect to update the svg-viewbox (for svg-imports)
deltas {:x (- (:x new-selrect) (:x selrect))
:y (- (:y new-selrect) (:y selrect))
:width (- (:width new-selrect) (:width selrect))
:height (- (:height new-selrect) (:height selrect))}]
(cond-> group
svg-viewbox
(update :svg-viewbox
#(-> %
(update :x + (:x deltas))
(update :y + (:y deltas))
(update :width + (:width deltas))
(update :height + (:height deltas)))))))
(defn update-group-selrect [group children]
(let [shape-center (gco/center-shape group)
transform (:transform group (gmt/matrix))
@ -297,6 +324,7 @@
;; Updates the shape and the applytransform-rect will update the other properties
(-> group
(update-group-viewbox new-selrect)
(assoc :selrect new-selrect)
(assoc :points new-points)

5
common/app/common/math.cljc
View file

@ -70,6 +70,11 @@
[v]
(- v))
(defn sq
"Calculates the square of a number"
[v]
(* v v))
(defn sqrt
"Returns the square root of a number."
[v]

5
common/app/common/pages.cljc
View file

@ -37,7 +37,7 @@
(d/export helpers/get-container)
(d/export helpers/get-shape)
(d/export helpers/get-component)
(d/export helpers/is-master-of)
(d/export helpers/is-main-of)
(d/export helpers/get-component-root)
(d/export helpers/get-children)
(d/export helpers/get-children-objects)
@ -62,6 +62,9 @@
(d/export helpers/touched-group?)
(d/export helpers/get-base-shape)
(d/export helpers/is-parent?)
(d/export helpers/get-index-in-parent)
(d/export helpers/calculate-z-index)
(d/export helpers/generate-child-all-parents-index)
;; Process changes
(d/export changes/process-changes)

4
common/app/common/pages/changes.cljc
View file

@ -160,7 +160,9 @@
(assoc :x (-> mask :selrect :x)
:y (-> mask :selrect :y)
:width (-> mask :selrect :width)
:height (-> mask :selrect :height)))))
:height (-> mask :selrect :height)
:flip-x (-> mask :flip-x)
:flip-y (-> mask :flip-y)))))
(update-group [group objects]
(let [children (->> group :shapes (map #(get objects %)))]
(cond

89
common/app/common/pages/helpers.cljc
View file

@ -89,11 +89,11 @@
(get-in libraries [library-id :data]))]
(get-in file [:components component-id])))
(defn is-master-of
[shape-master shape-inst]
(defn is-main-of
[shape-main shape-inst]
(and (:shape-ref shape-inst)
(or (= (:shape-ref shape-inst) (:id shape-master))
(= (:shape-ref shape-inst) (:shape-ref shape-master)))))
(or (= (:shape-ref shape-inst) (:id shape-main))
(= (:shape-ref shape-inst) (:shape-ref shape-main)))))
(defn get-component-root
[component]
@ -169,19 +169,36 @@
(assoc index id (:parent-id obj)))
{} objects))
(defn generate-child-all-parents-index
"Creates an index where the key is the shape id and the value is a set
with all the parents"
([objects]
(generate-child-all-parents-index objects (vals objects)))
([objects shapes]
(let [shape->parents
(fn [shape]
(->> (get-parents (:id shape) objects)
(into [])))]
(->> shapes
(map #(vector (:id %) (shape->parents %)))
(into {})))))
(defn clean-loops
"Clean a list of ids from circular references."
[objects ids]
(loop [ids ids
id (first ids)
others (rest ids)]
(if-not id
ids
(recur (cond-> ids
(some #(contains? ids %) (get-parents id objects))
(disj id))
(first others)
(rest others)))))
(let [parent-selected?
(fn [id]
(let [parents (get-parents id objects)]
(some ids parents)))
add-element
(fn [result id]
(cond-> result
(not (parent-selected? id))
(conj id)))]
(reduce add-element (d/ordered-set) ids)))
(defn calculate-invalid-targets
[shape-id objects]
@ -333,6 +350,41 @@
(reduce red-fn cur-idx (reverse (:shapes object)))))]
(into {} (rec-index '() uuid/zero))))
(defn calculate-z-index
"Given a collection of shapes calculates their z-index. Greater index
means is displayed over other shapes with less index."
[objects]
(let [is-frame? (fn [id] (= :frame (get-in objects [id :type])))
root-children (get-in objects [uuid/zero :shapes])
num-frames (->> root-children (filter is-frame?) count)]
(when (seq root-children)
(loop [current (peek root-children)
pending (pop root-children)
current-idx (+ (count objects) num-frames -1)
z-index {}]
(let [children (->> (get-in objects [current :shapes]))
children (cond
(and (is-frame? current) (contains? z-index current))
[]
(and (is-frame? current)
(not (contains? z-index current)))
(into [current] children)
:else
children)
pending (into (vec pending) children)]
(if (empty? pending)
(assoc z-index current current-idx)
(let []
(recur (peek pending)
(pop pending)
(dec current-idx)
(assoc z-index current current-idx)))))))))
(defn expand-region-selection
"Given a selection selects all the shapes between the first and last in
an indexed manner (shift selection)"
@ -401,3 +453,12 @@
(recur (get objects (first pending))
(conj done (:id current))
(concat (rest pending) (:shapes current))))))
(defn get-index-in-parent
"Retrieves the index in the parent"
[objects shape-id]
(let [shape (get objects shape-id)
parent (get objects (:parent-id shape))
[parent-idx _] (d/seek (fn [[idx child-id]] (= child-id shape-id))
(d/enumerate (:shapes parent)))]
parent-idx))

2
common/app/common/pages/spec.cljc
View file

@ -229,7 +229,7 @@
(s/def :internal.shape/stroke-color-ref-file (s/nilable uuid?))
(s/def :internal.shape/stroke-color-ref-id (s/nilable uuid?))
(s/def :internal.shape/stroke-opacity ::safe-number)
(s/def :internal.shape/stroke-style #{:solid :dotted :dashed :mixed :none})
(s/def :internal.shape/stroke-style #{:solid :dotted :dashed :mixed :none :svg})
(s/def :internal.shape/stroke-width ::safe-number)
(s/def :internal.shape/stroke-alignment #{:center :inner :outer})
(s/def :internal.shape/text-align #{"left" "right" "center" "justify"})

79
common/app/common/text.cljc Normal file
View file

@ -0,0 +1,79 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020-2021 UXBOX Labs SL
(ns app.common.text
(:require
[app.common.attrs :as attrs]
[app.common.data :as d]
[app.util.transit :as t]
[clojure.walk :as walk]
[cuerdas.core :as str]))
(def default-text-attrs
{:typography-ref-file nil
:typography-ref-id nil
:font-id "sourcesanspro"
:font-family "sourcesanspro"
:font-variant-id "regular"
:font-size "14"
:font-weight "400"
:font-style "normal"
:line-height "1.2"
:letter-spacing "0"
:text-transform "none"
:text-align "left"
:text-decoration "none"
:fill-color nil
:fill-opacity 1})
(def typography-fields
[:font-id
:font-family
:font-variant-id
:font-size
:font-weight
:font-style
:line-height
:letter-spacing
:text-transform])
(def default-typography
(merge
{:name "Source Sans Pro Regular"}
(select-keys default-text-attrs typography-fields)))
(defn transform-nodes
([transform root]
(transform-nodes identity transform root))
([pred transform root]
(walk/postwalk
(fn [item]
(if (and (map? item) (pred item))
(transform item)
item))
root)))
(defn node-seq
([root] (node-seq identity root))
([match? root]
(->> (tree-seq map? :children root)
(filter match?)
(seq))))
(defn ^boolean is-text-node?
[node]
(string? (:text node)))
(defn ^boolean is-paragraph-node?
[node]
(= "paragraph" (:type node)))
(defn ^boolean is-root-node?
[node]
(= "root" (:type node)))

31
common/app/common/version.cljc
View file

@ -13,27 +13,42 @@
[app.common.data :as d]
[cuerdas.core :as str]))
(def version-re #"^(([A-Za-z]+)\-?)?(\d+\.\d+\.\d+)(\-?((alpha|prealpha|beta|rc)(\d+)?))?(\-?(\d+))?(\-?(\w+))$")
(def version-re #"^(([A-Za-z]+)\-?)?((\d+)\.(\d+)\.(\d+))(\-?((alpha|prealpha|beta|rc|dev)(\d+)?))?(\-?(\d+))?(\-?g(\w+))$")
(defn parse
[data]
(cond
(= data "%version%")
{:full "develop"
:base "develop"
:branch "develop"
:base "0.0.0"
:main "0.0"
:major "0"
:minor "0"
:patch "0"
:modifier nil
:commit nil
:commit-hash nil}
(string? data)
(let [result (re-find version-re data)]
(let [result (re-find version-re data)
major (get result 4)
minor (get result 5)
patch (get result 6)
base (get result 3)
main (str/fmt "%s.%s" major minor)
branch (get result 2)]
{:full data
:base (get result 3)
:branch (get result 2)
:modifier (get result 5)
:commit (get result 9)
:commit-hash (get result 11)})
:base base
:main main
:major major
:minor minor
:patch patch
:branch branch
:modifier (get result 8)
:commit (get result 12)
:commit-hash (get result 14)})
:else nil))

81
docker/devenv/Dockerfile
View file

@ -3,8 +3,10 @@ LABEL maintainer="Andrey Antukh <niwi@niwi.nz>"
ARG DEBIAN_FRONTEND=noninteractive
ENV NODE_VERSION=v14.15.3 \
CLOJURE_VERSION=1.10.2.774 \
ENV NODE_VERSION=v14.16.0 \
CLOJURE_VERSION=1.10.3.822 \
CLJKONDO_VERSION=2021.03.31 \
BABASHKA_VERSION=0.3.2 \
LANG=en_US.UTF-8 \
LC_ALL=en_US.UTF-8
@ -25,6 +27,7 @@ RUN set -ex; \
git \
rlwrap \
unzip \
fakeroot \
; \
echo "en_US.UTF-8 UTF-8" >> /etc/locale.gen; \
locale-gen; \
@ -41,7 +44,6 @@ RUN set -ex; \
python \
build-essential \
imagemagick \
librsvg2-bin \
netpbm \
potrace \
webp \
@ -82,6 +84,7 @@ RUN set -ex; \
libxi6 \
libxrandr2 \
libxrender1 \
libxshmfence1 \
libxss1 \
libxtst6 \
fonts-liberation \
@ -92,17 +95,20 @@ RUN set -ex; \
rm -rf /var/lib/apt/lists/*;
RUN set -ex; \
mkdir -p /usr/share/man/man1; \
mkdir -p /usr/share/man/man7; \
wget -qO - https://adoptopenjdk.jfrog.io/adoptopenjdk/api/gpg/key/public | apt-key add -; \
echo "deb https://adoptopenjdk.jfrog.io/adoptopenjdk/deb/ focal main" >> /etc/apt/sources.list.d/adoptopenjdk.list; \
apt-get -qq update; \
apt-get -qqy install adoptopenjdk-15-hotspot; \
rm -rf /var/lib/apt/lists/*; \
wget "https://download.clojure.org/install/linux-install-$CLOJURE_VERSION.sh"; \
chmod +x "linux-install-$CLOJURE_VERSION.sh"; \
"./linux-install-$CLOJURE_VERSION.sh"; \
rm -rf "linux-install-$CLOJURE_VERSION.sh"
curl -LfsSo /tmp/openjdk.tar.gz https://github.com/AdoptOpenJDK/openjdk16-binaries/releases/download/jdk-16%2B36/OpenJDK16-jdk_x64_linux_hotspot_16_36.tar.gz; \
mkdir -p /usr/lib/jvm/openjdk16; \
cd /usr/lib/jvm/openjdk16; \
tar -xf /tmp/openjdk.tar.gz --strip-components=1; \
rm -rf /tmp/openjdk.tar.gz;
ENV PATH="/usr/lib/jvm/openjdk16/bin:/usr/local/nodejs/bin:$PATH" \
JAVA_HOME=/usr/lib/jvm/openjdk16
RUN set -ex; \
curl -LfsSo /tmp/clojure.sh https://download.clojure.org/install/linux-install-$CLOJURE_VERSION.sh; \
chmod +x /tmp/clojure.sh; \
/tmp/clojure.sh; \
rm -rf /tmp/clojure.sh;
RUN set -ex; \
curl https://www.postgresql.org/media/keys/ACCC4CF8.asc | sudo apt-key add -; \
@ -111,31 +117,33 @@ RUN set -ex; \
apt-get -qqy install postgresql-client-13; \
rm -rf /var/lib/apt/lists/*;
COPY files/phantomjs-mock /usr/bin/phantomjs
COPY files/bashrc /root/.bashrc
COPY files/vimrc /root/.vimrc
COPY files/tmux.conf /root/.tmux.conf
WORKDIR /home
RUN set -ex; \
mkdir -p /tmp/node; \
cd /tmp/node; \
export PATH="$PATH:/usr/local/nodejs/bin"; \
wget https://nodejs.org/dist/$NODE_VERSION/node-$NODE_VERSION-linux-x64.tar.xz; \
tar xvf node-$NODE_VERSION-linux-x64.tar.xz; \
mv /tmp/node/node-$NODE_VERSION-linux-x64 /usr/local/nodejs; \
curl -LfsSo /tmp/nodejs.tar.xz https://nodejs.org/dist/$NODE_VERSION/node-$NODE_VERSION-linux-x64.tar.xz; \
mkdir -p /usr/local/nodejs; \
cd /usr/local/nodejs; \
tar -xf /tmp/nodejs.tar.xz --strip-components=1; \
chown -R root /usr/local/nodejs; \
PATH="$PATH:/usr/local/nodejs/bin"; \
/usr/local/nodejs/bin/npm install -g yarn; \
/usr/local/nodejs/bin/npm install -g svgo; \
rm -rf /tmp/node;
rm -rf /tmp/nodejs.tar.xz;
# Install clj-kondo
RUN set -ex; \
curl -LfsSo /tmp/clj-kondo.zip https://github.com/borkdude/clj-kondo/releases/download/v$CLJKONDO_VERSION/clj-kondo-$CLJKONDO_VERSION-linux-amd64.zip; \
cd /usr/local/bin; \
unzip /tmp/clj-kondo.zip; \
rm /tmp/clj-kondo.zip;
# Install babashka
RUN set -ex; \
cd /tmp; \
wget https://github.com/borkdude/clj-kondo/releases/download/v2021.01.20/clj-kondo-2021.01.20-linux-amd64.zip; \
unzip clj-kondo-2021.01.20-linux-amd64.zip; \
mv clj-kondo /usr/local/bin/; \
rm clj-kondo-2021.01.20-linux-amd64.zip;
curl -LfsSo /tmp/babashka.tar.gz https://github.com/babashka/babashka/releases/download/v$BABASHKA_VERSION/babashka-$BABASHKA_VERSION-linux-amd64.tar.gz; \
cd /usr/local/bin; \
tar -xf /tmp/babashka.tar.gz; \
rm -rf /tmp/babashka.tar.gz;
WORKDIR /home
EXPOSE 3447
EXPOSE 3448
@ -143,10 +151,17 @@ EXPOSE 3449
EXPOSE 6060
EXPOSE 9090
COPY files/nginx.conf /etc/nginx/nginx.conf
COPY files/phantomjs-mock /usr/bin/phantomjs
COPY files/bashrc /root/.bashrc
COPY files/vimrc /root/.vimrc
COPY files/tmux.conf /root/.tmux.conf
COPY files/sudoers /etc/sudoers
COPY files/start-tmux.sh /home/start-tmux.sh
COPY files/entrypoint.sh /home/entrypoint.sh
COPY files/init.sh /home/init.sh
COPY files/bashrc /home/penpot/.bashrc
ENTRYPOINT ["/home/entrypoint.sh"]
CMD ["/home/init.sh"]

10
docker/devenv/docker-compose.yaml
View file

@ -27,7 +27,6 @@ services:
volumes:
- "user_data:/home/penpot/"
- "${PWD}:/home/penpot/penpot"
- ./files/nginx.conf:/etc/nginx/nginx.conf
ports:
- 3447:3447
@ -38,10 +37,6 @@ services:
- 9090:9090
environment:
- PENPOT_DATABASE_URI=postgresql://postgres/penpot
- PENPOT_DATABASE_USERNAME=penpot
- PENPOT_DATABASE_PASSWORD=penpot
- PENPOT_REDIS_URI=redis://redis/0
- EXTERNAL_UID=${CURRENT_USER_ID}
# STMP setup
- PENPOT_SMTP_ENABLED=true
@ -70,7 +65,6 @@ services:
postgres:
image: postgres:13
command: postgres -c config_file=/etc/postgresql.conf
container_name: "penpot-devenv-postgres"
restart: always
stop_signal: SIGINT
environment:
@ -91,8 +85,6 @@ services:
mailer:
image: sj26/mailcatcher:latest
hostname: mautic-mailer
container_name: mautic-mailer
restart: always
expose:
- '1025'
@ -101,8 +93,6 @@ services:
ldap:
image: rroemhild/test-openldap:2.1
container_name: mautic-ldap
hostname: mautic-ldap
expose:
- '10389'
- '10636'

2
docker/devenv/files/bashrc
View file

@ -1,6 +1,6 @@
#!/usr/bin/env bash
export PATH=/usr/local/nodejs/bin:$PATH
export PATH=/usr/lib/jvm/openjdk16/bin:/usr/local/nodejs/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/snap/bin
alias l='ls --color -GFlh'
alias rm='rm -r'

2
docker/devenv/files/entrypoint.sh
View file

@ -1,5 +1,7 @@
#!/usr/bin/env bash
export PATH=/usr/lib/jvm/openjdk16/bin:/usr/local/nodejs/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/snap/bin
set -e
usermod -u ${EXTERNAL_UID:-1000} penpot

5
docker/devenv/files/init.sh
View file

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

2
docker/devenv/files/nginx.conf
View file

@ -91,7 +91,7 @@ http {
location /internal/assets {
internal;
alias /home/penpot/penpot/backend/resources/public/assets;
alias /home/penpot/penpot/backend/assets;
add_header x-internal-redirect "$upstream_http_x_accel_redirect";
}

12
docker/devenv/files/start-tmux.sh
View file

@ -1,17 +1,13 @@
#!/usr/bin/env bash
sudo cp /root/.bashrc /home/penpot/.bashrc
sudo cp /root/.vimrc /home/penpot/.vimrc
sudo cp /root/.tmux.conf /home/penpot/.tmux.conf
source /home/penpot/.bashrc
sudo chown penpot:users /home/penpot
cd ~;
set -e;
source ~/.bashrc
set -e;
echo "[start-tmux.sh] Installing node dependencies"
pushd ~/penpot/frontend/
yarn install
@ -30,7 +26,9 @@ tmux send-keys -t penpot 'npx shadow-cljs watch main' enter
tmux new-window -t penpot:2 -n 'exporter'
tmux select-window -t penpot:2
tmux send-keys -t penpot 'cd penpot/exporter' enter C-l
tmux send-keys -t penpot 'rm -f target/app.js*' enter C-l
tmux send-keys -t penpot 'npx shadow-cljs watch main' enter
tmux split-window -v
tmux send-keys -t penpot 'cd penpot/exporter' enter C-l
tmux send-keys -t penpot './scripts/wait-and-start.sh' enter
@ -43,6 +41,6 @@ tmux send-keys -t penpot './scripts/start-dev' enter
tmux rename-window -t penpot:0 'gulp'
tmux select-window -t penpot:0
tmux send-keys -t penpot 'cd penpot/frontend' enter C-l
tmux send-keys -t penpot 'npx gulp --theme=${PENPOT_THEME} watch' enter
tmux send-keys -t penpot 'npx gulp watch' enter
tmux -2 attach-session -t penpot

8
docker/devenv/files/sudoers Normal file
View file

@ -0,0 +1,8 @@
Defaults env_reset
Defaults mail_badpass
#Defaults secure_path="/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/snap/bin"
root ALL=(ALL:ALL) ALL
penpot ALL=(ALL) NOPASSWD:ALL
%admin ALL=(ALL) ALL
%sudo ALL=(ALL:ALL) ALL

56
docker/devenv/files/zshrc
View file

@ -1,56 +0,0 @@
#!/usr/bin/env zsh
export EDITOR=vim
bindkey "^[[3~" delete-char
bindkey "^[3;5~" delete-char
bindkey '^R' history-incremental-search-backward
bindkey -e
autoload -U promptinit
promptinit
prompt suse
#------------------------------
## Comp stuff
##------------------------------
zmodload zsh/complist
autoload -Uz compinit
compinit
#------------------------------
# Alias stuff
#------------------------------
alias cp='cp -r'
alias ls='ls -F'
alias l='ls -Flha'
alias rm='rm -r'
alias ls='ls --color -F'
alias lsd='ls -d *(/)'
alias lsf='ls -h *(.)'
#-----------------
# Options
#-----------------
setopt AUTO_CD # implicate cd for non-commands
setopt CORRECT_ALL # correct spelling
setopt COMPLETE_IN_WORD # complete commands anywhere in the word
setopt NOTIFY # Notify when jobs finish
setopt BASH_AUTO_LIST # Autolist options on repeition of ambiguous args
setopt AUTO_PUSHD # Push dirs into history
setopt MULTIOS # Allow Multiple pipes
setopt MAGIC_EQUAL_SUBST # Expand inside equals
setopt EXTENDED_GLOB
setopt NOBEEP
setopt INC_APPEND_HISTORY
export HISTSIZE=100000
export SAVEHIST=100000
export HISTFILE=~/local/.zhistory
setopt hist_ignore_all_dups
setopt hist_ignore_space
export PATH=$HOME/.local/bin:$PATH
export NVM_DIR="$HOME/.nvm"
[ -s "$NVM_DIR/nvm.sh" ] && . "$NVM_DIR/nvm.sh" # This loads nvm

38
docker/images/Dockerfile.backend
View file

@ -3,19 +3,43 @@ LABEL maintainer="Andrey Antukh <niwi@niwi.nz>"
ENV LANG='en_US.UTF-8' LC_ALL='en_US.UTF-8'
WORKDIR /root
RUN set -ex; \
apt-get -qq update; \
apt-get -qqy --no-install-recommends install wget locales ca-certificates imagemagick webp gnupg2; \
apt-get -qqy --no-install-recommends install curl tzdata locales ca-certificates imagemagick webp fontconfig; \
echo "en_US.UTF-8 UTF-8" >> /etc/locale.gen; \
locale-gen; \
mkdir -p /usr/share/man/man1; \
mkdir -p /usr/share/man/man7; \
wget -qO - https://adoptopenjdk.jfrog.io/adoptopenjdk/api/gpg/key/public | apt-key add -; \
echo "deb https://adoptopenjdk.jfrog.io/adoptopenjdk/deb/ focal main" >> /etc/apt/sources.list.d/adoptopenjdk.list; \
apt-get -qq update; \
apt-get -qqy install adoptopenjdk-15-hotspot; \
rm -rf /var/lib/apt/lists/*;
RUN set -eux; \
ARCH="$(dpkg --print-architecture)"; \
case "${ARCH}" in \
aarch64|arm64) \
ESUM='7217a9f9be3b0c8dfc78538f95fd2deb493eb651152d975062920566492b2574'; \
BINARY_URL='https://github.com/AdoptOpenJDK/openjdk16-binaries/releases/download/jdk-16%2B36/OpenJDK16-jdk_aarch64_linux_hotspot_16_36.tar.gz'; \
;; \
armhf|armv7l) \
ESUM='f1d32ba01a40c98889f31368c0e987d6bbda65a7c50b8c088623b48e3a90104a'; \
BINARY_URL='https://github.com/AdoptOpenJDK/openjdk16-binaries/releases/download/jdk-16%2B36/OpenJDK16-jdk_arm_linux_hotspot_16_36.tar.gz'; \
;; \
amd64|x86_64) \
ESUM='2e031cf37018161c9e59b45fa4b98ff2ce4ce9297b824c512989d579a70f8422'; \
BINARY_URL='https://github.com/AdoptOpenJDK/openjdk16-binaries/releases/download/jdk-16%2B36/OpenJDK16-jdk_x64_linux_hotspot_16_36.tar.gz'; \
;; \
*) \
echo "Unsupported arch: ${ARCH}"; \
exit 1; \
;; \
esac; \
curl -LfsSo /tmp/openjdk.tar.gz ${BINARY_URL}; \
echo "${ESUM} */tmp/openjdk.tar.gz" | sha256sum -c -; \
mkdir -p /usr/lib/jvm/openjdk16; \
cd /usr/lib/jvm/openjdk16; \
tar -xf /tmp/openjdk.tar.gz --strip-components=1; \
rm -rf /tmp/openjdk.tar.gz;
ENV JAVA_HOME=/usr/lib/jvm/openjdk16 PATH="/usr/lib/jvm/openjdk16/bin:$PATH"
ADD ./bundle-app/backend/ /opt/bundle/
WORKDIR /opt/bundle
CMD ["/bin/bash", "run.sh"]

52
docker/images/Dockerfile.exporter
View file

@ -5,24 +5,13 @@ ARG DEBIAN_FRONTEND=noninteractive
ENV LANG=en_US.UTF-8 \
LC_ALL=en_US.UTF-8 \
NODE_VERSION=v14.15.1
NODE_VERSION=v14.16.0
RUN set -ex; \
mkdir -p /etc/resolvconf/resolv.conf.d; \
echo "nameserver 8.8.8.8" > /etc/resolvconf/resolv.conf.d/tail; \
apt-get -qq update; \
apt-get -qqy install --no-install-recommends \
locales \
gnupg2 \
ca-certificates \
wget \
sudo \
vim \
curl \
bash \
xz-utils \
rlwrap \
; \
apt-get -qqy --no-install-recommends install curl tzdata locales ca-certificates fontconfig xz-utils; \
echo "en_US.UTF-8 UTF-8" >> /etc/locale.gen; \
locale-gen; \
rm -rf /var/lib/apt/lists/*;
@ -72,22 +61,37 @@ RUN set -ex; \
; \
rm -rf /var/lib/apt/lists/*;
RUN set -ex; \
mkdir -p /tmp/node; \
cd /tmp/node; \
export PATH="$PATH:/usr/local/nodejs/bin"; \
wget https://nodejs.org/dist/$NODE_VERSION/node-$NODE_VERSION-linux-x64.tar.xz; \
tar xvf node-$NODE_VERSION-linux-x64.tar.xz; \
mv /tmp/node/node-$NODE_VERSION-linux-x64 /usr/local/nodejs; \
ENV PATH="/usr/local/nodejs/bin:$PATH"
RUN set -eux; \
ARCH="$(dpkg --print-architecture)"; \
case "${ARCH}" in \
aarch64|arm64) \
BINARY_URL="https://nodejs.org/dist/${NODE_VERSION}/node-${NODE_VERSION}-linux-arm64.tar.xz"; \
;; \
armhf|armv7l) \
BINARY_URL="https://nodejs.org/dist/${NODE_VERSION}/node-${NODE_VERSION}-linux-armv7l.tar.xz"; \
;; \
amd64|x86_64) \
BINARY_URL="https://nodejs.org/dist/${NODE_VERSION}/node-${NODE_VERSION}-linux-x64.tar.xz"; \
;; \
*) \
echo "Unsupported arch: ${ARCH}"; \
exit 1; \
;; \
esac; \
curl -LfsSo /tmp/nodejs.tar.xz ${BINARY_URL}; \
mkdir -p /usr/local/nodejs; \
cd /usr/local/nodejs; \
tar -xf /tmp/nodejs.tar.xz --strip-components=1; \
chown -R root /usr/local/nodejs; \
/usr/local/nodejs/bin/npm install -g yarn; \
rm -rf /tmp/node;
rm -rf /tmp/nodejs.tar.xz;
WORKDIR /opt/app
ADD ./bundle-exporter/ /opt/app/
RUN set -ex; \
export PATH="$PATH:/usr/local/nodejs/bin"; \
yarn install;
RUN set -ex; yarn install;
CMD ["/usr/local/nodejs/bin/node", "app.js"]

62
docs/00-Getting-Started.md
View file

@ -1,62 +0,0 @@
# Getting Started ##
This documentation intends to explain how to get penpot application and run it locally.
The simplest approach is using docker and docker-compose.
## Install Docker ##
Skip this section if you already have docker installed, up and running.
You can install docker and its dependencies from your distribution
repository with:
```bash
sudo apt-get install docker docker-compose
```
Or follow installation instructions from docker.com; (for Debian
https://docs.docker.com/engine/install/debian/).
Ensure that the docker is started and optionally enable it to start
with the system:
```bash
sudo systemctl start docker
sudo systemctl enable docker
```
And finally, add your user to the docker group:
```basb
sudo usermod -aG docker $USER
```
This will make use of the docker without `sudo` command all the time.
NOTE: probably you will need to re-login again to make this change
take effect.
## Start penpot application ##
You can create it from scratch or take a base from the [penpot
repository][1]
[1]: https://raw.githubusercontent.com/penpot/penpot/develop/docker/images/docker-compose.yaml
```bash
wget https://raw.githubusercontent.com/penpot/penpot/develop/docker/images/docker-compose.yaml
```
And then:
```bash
docker-compose -p penpot -f docker-compose.yaml up
```
The docker compose file contains the essential configuration for
getting the application running, and many essential configurations
already explained in the comments. All other configuration options are
explained in [configuration guide](./05-Configuration-Guide.md).

146
docs/01-Development-Environment.md
View file

@ -1,146 +0,0 @@
# Developer Guide #
This is a generic "getting started" guide for the Penpot platform. It
intends to explain how to get the development environment up and
running with many additional tips.
The main development environment consists in a docker compose
configuration that starts the external services and the development
container (called **devenv**).
We use tmux script in order to multiplex the single terminal and run
both the backend and frontend in the same container.
## System requirements ##
You should have `docker` and `docker-compose` installed in your system
in order to set up properly the development enviroment.
In debian like linux distributions you can install it executing:
```bash
sudo apt-get install docker docker-compose
```
Start and enable docker environment:
```bash
sudo systemctl start docker
sudo systemctl enable docker
```
Add your user to the docker group:
```basb
sudo usermod -aG docker $USER
```
And finally, increment user watches:
```
echo fs.inotify.max_user_watches=524288 | sudo tee -a /etc/sysctl.conf && sudo sysctl -p
```
NOTE: you probably need to login again for group change take the effect.
## Start the devenv ##
**Requires a minimum knowledge of tmux usage in order to use that
development environment.**
For start it, staying in this repository, execute:
```bash
./manage.sh pull-devenv
./manage.sh run-devenv
```
This will do the following:
- Pulls the latest devenv image.
- Starts all the containers in the background.
- Attaches to the **devenv** container and executes the tmux session.
- The tmux session automatically starts all the necessary services.
You can execute the individual steps manully if you want:
```bash
./manage.sh build-devenv # builds the devenv docker image (not necessary in normal sircumstances)
./manage.sh start-devenv # starts background running containers
./manage.sh run-devenv # enters to new tmux session inside of one of the running containers
./manage.sh stop-devenv # stops background running containers
./manage.sh drop-devenv # removes all the volumes, containers and networks used by the devenv
```
Now having the the container running and tmux open inside the
container, you are free to execute any commands and open many shells
as you want.
You can create a new shell just pressing the **Ctr+b c** shortcut. And
**Ctrl+b w** for switch between windows, **Ctrl+b &** for kill the
current window.
For more info: https://tmuxcheatsheet.com/
### Inside the tmux session
#### gulp
The styles and many related tasks are executed thanks to gulp and they are
executed in the tmux **window 0**. This is a normal gulp watcher with some
additional tasks.
#### shadow-cljs
The frontend build process is located on the tmux **window 1**.
**Shadow-cljs** is used for build and serve the frontend code. For
more information, please refer to `02-Frontend-Developer-Guide.md`.
By default the **window 1** executes the shadow-cljs watch process,
that starts a new JVM/Clojure instance if there is no one running.
Finally, you can start a REPL linked to the instance and the current
connected browser, by opening a third window with `Ctrl+c` and running
`npx shadow-cljs cljs-repl main`.
#### exporter
The exporter app (clojurescript app running in nodejs) is located in
**window 2**, and you can go directly to it using `ctrl+b 2` shortcut.
There you will found the window split in two slices. On the top slice
you will have the build process (using shadow-cljs in the same way as
frontend application), and on the bot slice the script that launeches
the node process.
If some reason scripts does not stars correctly, you can manually
execute `node target/app.js ` to start the exporter app.
#### backend
The backend related environment is located in the tmux **window 3**,
and you can go directly to it using `ctrl+b 2` shortcut.
By default the backend will be started in non-interactive mode for
convenience but you can just press `Ctrl+c` and execute `./scripts/repl`
for start the repl.
On the REPL you have this helper functions:
- `(start)`: start all the environment
- `(stop)`: stops the environment
- `(restart)`: stops, reload and start again.
And many other that are defined in the `dev/user.clj` file.
If some exception is raised when code is reloaded, just use
`(repl/refresh-all)` in order to finish correctly the code swaping and
later use `(restart)` again.
For more information, please refer to: `03-Backend-Guide.md`.

283
docs/02-Frontend-Developer-Guide.md
View file

@ -1,283 +0,0 @@
# Frontend Guide #
This guide intends to explain the essential details of the frontend
application.
## Visual debug mode and utilities
Debugging a problem in the viewport algorithms for grouping and
rotating is difficult. We have set a visual debug mode that displays
some annotations on screen, to help understanding what's happening.
To activate it, open the javascript console and type
```javascript
app.util.debug.toggle_debug("option")
```
Current options are `bounding-boxes`, `group`, `events` and
`rotation-handler`.
You can also activate or deactivate all visual aids with
```javascript
app.util.debug.debug_all()
app.util.debug.debug_none()
```
## Logging, Tracing & Debugging
As a traditional way for debugging and tracing you have the followimg approach:
Print data to the devtool console using clojurescript helper:
**prn**. This helper automatically formats the clojure and js data
structures as plain EDN for easy visual inspection of the data and the
type of the data.
```clojure
(prn "message" expression)
```
An alternative is using the pprint function, usefull for pretty
printing a medium-big data sturcture for completly understand it.
```clojure
(:require [cljs.pprint :refer [pprint]])
(pprint expression)
; Outputs a clojure value as a string, nicely formatted and with data type information.
```
Use the js native functions for printing data. The clj->js converts
the clojure data sturcture to js data sturcture and it is
inspeccionable in the devtools console.
```clojure
(js/console.log "message" (clj->js expression))
```
Also we can insert breakpoints in the code with this function:
```clojure
(js-debugger)
```
You can also set a breakpoint from the sources tab in devtools. One
way of locating a source file is to output a trace with
(js/console.log) and then clicking in the source link that shows in
the console.
### Logging framework
Additionally to the traditional way of putting traces in the code, we
have a logging framework with steroids. It is usefull for casual
debugging (as replacement for a `prn` and `js/console.log`) and as a
permanent traces in the code.
You have the ability to specify the logging level per namespace and
all logging is ellided in production build.
Lets start with a simple example:
```clojure
(ns some.ns
(:require [app.util.logging :as log]))
;; This function sets the level to the current namespace; messages
;; with level behind this will not be printed.
(log/set-level! :info)
;; Log some data; The `app.util.logging` has the following
;; functions/macros:
(log/error :msg "error message")
(log/warn :msg "warn message")
(log/info :msg "info message")
(log/debug :msg "debug message")
(log/trace :msg "trace message")
```
Each macro accept arbitrary number of key values pairs:
```clojure
(log/info :foo "bar" :msg "test" :value 1 :items #{1 2 3})
```
Some keys ara treated as special cases for helping in debugging:
```clojure
;; The special case for :js/whatever; if you namespace the key
;; with `js/`, the variable will be printed as javascript
;; inspectionable object.
(let [foobar {:a 1 :b 2}]
(log/info :msg "Some data" :js/data foobar))
;; The special case for `:err`; If you attach this key, the
;; exception stack trace is printed as additional log entry.
```
## Access to clojure from javascript console
The penpot namespace of the main application is exported, so that is
accessible from javascript console in Chrome developer tools. Object
names and data types are converted to javascript style. For example
you can emit the event to reset zoom level by typing this at the
console (there is autocompletion for help):
```javascript
app.main.store.emit_BANG_(app.main.data.workspace.reset_zoom)
```
## Debug state and objects
There are also some useful functions to visualize the global state or
any complex object. To use them from clojure:
```clojure
(ns app.util.debug)
(logjs <msg> <var>) ; to print the value of a variable
(tap <fn>) ; to include a function with side effect (e.g. logjs) in a transducer.
(ns app.main.store)
(dump-state) ; to print in console all the global state
(dump-objects) ; to print in console all objects in workspace
```
But last ones are most commonly used from javscript console:
```javascript
app.main.store.dump_state()
app.main.store.dump_objects()
```
And we have also exported `pprint` and `clj->js` functions for the console:
```javascript
pp(js_expression) // equivalent to cljs.pprint.pprint(js_expression)
dbg(js_expression) // equivalent to cljs.core.clj__GT_js(js_expression)
```
## Icons & Assets
The icons used on the frontend application are loaded using svgsprite
(properly handled by the gulp watch task). All icons should be on SVG
format located in `resources/images/icons`. The gulp task will
generate the sprite and the embedd it into the `index.html`.
Then, you can reference the icon from the sprite using the
`app.builtins.icons/icon-xref` macro:
```clojure
(ns some.namespace
(:require-macros [app.main.ui.icons :refer [icon-xref]]))
(icon-xref :arrow)
```
For performance reasons, all used icons are statically defined in the
`src/app/main/ui/icons.cljs` file.
## Translations (I18N) ##
### How it Works ###
All the translation strings of this application are stored in
`resources/locales.json` file. It has a self explanatory format that
looks like this:
```json
{
"auth.email-or-username" : {
"used-in" : [ "src/app/main/ui/auth/login.cljs:61" ],
"translations" : {
"en" : "Email or Username",
"fr" : "adresse email ou nom d'utilisateur"
}
},
"ds.num-projects" : {
"translations": {
"en": ["1 project", "%s projects"]
}
},
}
```
For development convenience, you can forget about the specific format
of that file, and just add a simple key-value entry pairs like this:
```
{
[...],
"foo1": "bar1",
"foo2": "bar2"
}
```
The file is automatically bundled into the `index.html` file on
compile time (in development and production). The bundled content is a
simplified version of this data structure for avoid load unnecesary
data.
The development environment has a watch process that detect changes on
that file and recompiles the `index.html`. **There are no hot reload
for translations strings**, you just need to refresh the browser tab
for refresh the translations in the running the application.
If you have used the short (key-value) format, the watch process will
automatically convert it to the apropriate format before generate the
`index.html`.
Finally, when you have finished to adding texts, execute the following
command for reformat the file, and track the usage locations (the
"used-in" list) before commiting the file into the repository:
```bash
clojure -Adev locales.clj collect src/app/main/ resources/locales.json
```
NOTE: Later, we will need to think and implement the way to export and
import to other formats (mainly for transifex and similar services
compatibility).
### How to use it ###
You have two aproaches for translate strings: one for general purpose
and other specific for React components (that leverages reactivity for
language changes).
The `app.util.i18n/tr` is the general purpose function. This is a
simple use case example:
```clojure
(require '[app.util.i18n :refer [tr])
(tr "auth.email-or-username")
;; => "Email or Username"
```
If you have defined plurals for some translation resource, then you
need to pass an additional parameter marked as counter in order to
allow the system know when to show the plural:
```clojure
(require '[app.util.i18n :as i18n :refer [tr]])
(tr "ds.num-projects" (i18n/c 10))
;; => "10 projects"
(tr "ds.num-projects" (i18n/c 1))
;; => "1 project"
```

76
docs/03-Backend-Developer-Guide.md
View file

@ -1,76 +0,0 @@
# Backend Developer Guide #
This guide intends to explain the essential details of the backend
application.
## Fixtures ##
This is a development feature that allows populate the database with a
good amount of content (usually used for just test the application or
perform performance tweaks on queries).
In order to load fixtures, enter to the REPL environment executing the
`bin/repl` script, and then execute `(app.cli.fixtures/run {:preset :small})`.
You also can execute this as a standalone script with:
```bash
clojure -Adev -X:fn-fixtures
```
NOTE: It is an optional step because the application can start with an
empty database.
This by default will create a bunch of users that can be used to login
in the aplication. All users uses the following pattern:
- Username: `profileN@example.com`
- Password: `123123`
Where `N` is a number from 0 to 5 on the default fixture parameters.
If you have a REPL access to the running process, you can execute it
from there:
```clojure
(require 'app.cli.fixtures)
(app.cli.fixtures/run :small)
```
To access to the running process repl you usually will execute this
command:
```bash
rlwrap netcat localhost 6062
```
## Migrations
The database migrations are located in two directories:
- `src/app/migrations` (contains migration scripts in clojure)
- `src/app/migrations/sql` (contains the pure SQL migrations)
The SQL migration naming consists in the following:
```
XXXX-<add|mod|del|drop|[...verb...]>-<table-name>-<any-additional-text>
```
Examples:
```
0025-del-generic-tokens-table
0026-mod-profile-table-add-is-active-field
```
**NOTE**: if table name has more than one words, we still use `-` as a separator.
If you need to have a global overview of the all schema of the database you can extract it
using postgresql:
```bash
# (in the devenv environment)
pg_dump -h postgres -s > schema.sql
```

61
docs/04-Common-Developer-Guide.md
View file

@ -1,61 +0,0 @@
# Common's guide #
This section intends to have articles that related to both frontend
and backend, such as: code style hints, architecture dicisions, etc...
## Assertions ##
Penpot source code has this types of assertions:
**assert**: just using the clojure builtin `assert` macro.
Example:
```clojure
(assert (number? 3) "optional message")
```
This asserts are only executed on development mode. On production
environment all assets like this will be ignored by runtime.
**spec/assert**: using the `app.common.spec/assert` macro.
Also, if you are using clojure.spec, you have the spec based
`clojure.spec.alpha/assert` macro. In the same way as the
`clojure.core/assert`, on production environment this asserts will be
removed by the compiler/runtime.
Example:
````clojure
(require '[clojure.spec.alpha :as s]
'[app.common.spec :as us])
(s/def ::number number?)
(us/assert ::number 3)
```
In the same way as the `assert` macro, this performs the spec
assertion only on development build. On production this code will
completely removed.
**spec/verify**: An assertion type that is executed always.
Example:
```clojure
(require '[app.common.spec :as us])
(us/verify ::number 3)
```
This macro enables you have assetions on production code.
**Why don't use the `clojure.spec.alpha/assert` instead of the `app.common.spec/assert`?**
The Penpot variant does not peforms additional runtime checks for know
if asserts are disabled in "runtime". As a result it generates much
simplier code at development and production builds.

240
docs/05-Configuration-Guide.md
View file

@ -1,240 +0,0 @@
# Configuration Guide #
This section intends to explain all available configuration options.
## Backend ##
The default approach for pass options to backend application is using
environment variables. Almost all environment variables starts with
the `PENPOT_` prefix.
NOTE: All the examples that comes with values, they represent the
**default** values.
### Configuration Options
#### Database Connection
```sh
PENPOT_DATABASE_USERNAME=penpot
PENPOT_DATABASE_PASSWORD=penpot
PENPOT_DATABASE_URI=postgresql://127.0.0.1/penpot
```
The username and password are optional.
#### Email (SMTP)
```sh
PENPOT_SMTP_DEFAULT_REPLY_TO=no-reply@example.com
PENPOT_SMTP_DEFAULT_FROM=no-reply@example.com
# When not enabled, the emails are printed to the console.
PENPOT_SMTP_ENABLED=false
PENPOT_SMTP_HOST=<host>
PENPOT_SMTP_PORT=25
PENPOT_SMTP_USER=<username>
PENPOT_SMTP_PASSWORD=<password>
PENPOT_SMTP_SSL=false
PENPOT_SMTP_TLS=false
```
#### Storage (assets)
Assets storage is implemented using "plugable" backends. Currently
there are three backends available: `db`, `fs` and `s3` (for AWS S3).
##### fs backend
The default backend is: **fs**.
```sh
PENPOT_STORAGE_BACKEND=fs
PENPOT_STORAGE_FS_DIRECTORY=resources/public/assets`
```
The fs backend is hightly coupled with nginx way to serve files using
`x-accel-redirect` and for correctly configuring it you will need to
touch your nginx config for correctly expose the directory specified
in `PENPOT_STORAGE_FS_DIRECTORY` environment.
For more concrete example look at the devenv nginx configurtion
located in `<repo-root>/docker/devenv/files/nginx.conf`.
**NOTE**: The **fs** storage backend is used for store temporal files
when a user uploads an image and that image need to be processed for
creating thumbnails. So is **hightly recommeded** setting up a correct
directory for this backend independently if it is used as main backend
or not.
##### db backend
In some circumstances or just for convenience you can use the `db`
backend that stores all media uploaded by the user directly inside the
database. This backend, at expenses of some overhead, facilitates the
backups, because with this backend all that you need to backup is the
postgresql database. Convenient for small installations and personal
use.
```sh
PENPOT_STORAGE_BACKEND=db
```
##### s3 backend
And finally, you can use AWS S3 service as backend for assets
storage. For this you will need to have AWS credentials, an bucket and
the region of the bucket.
```sh
AWS_ACCESS_KEY_ID=<you-access-key-id-here>
AWS_SECRET_ACCESS_KEY=<your-secret-access-key-here>
PENPOT_STORAGE_BACKEND=s3
PENPOT_STORAGE_S3_REGION=<aws-region>
PENPOT_STORAGE_S3_BUCKET=<bucket-name>
```
Right now, only `eu-central-1` region is supported. If you need others, open an issue.
#### Redis
The redis configuration is very simple, just provide with a valid redis URI. Redis is used
mainly for websocket notifications coordination.
```sh
PENPOT_REDIS_URI=redis://localhost/0
```
#### HTTP Server
```sh
PENPOT_HTTP_SERVER_PORT=6060
PENPOT_PUBLIC_URI=http://localhost:3449
PENPOT_REGISTRATION_ENABLED=true
# comma-separated domains, defaults to `""` which means that all domains are allowed)
PENPOT_REGISTRATION_DOMAIN_WHITELIST=""
```
#### Server REPL
The production environment by default starts a server REPL where you
can connect and perform diagnosis operations. For this you will need
`netcat` or `telnet` installed in the server.
```bash
$ rlwrap netcat localhost 6062
user=>
```
The default configuration is:
```sh
PENPOT_SREPL_HOST=127.0.0.1
PENPOT_SREPL_PORT=6062
```
#### Auth with 3rd party
**NOTE**: a part of setting this configuration on backend, frontend
application will also require configuration tweaks for make it work.
##### Google
```sh
PENPOT_GOOGLE_CLIENT_ID=<client-id>
PENPOT_GOOGLE_CLIENT_SECRET=<client-secret>
```
##### Gitlab
```sh
PENPOT_GITLAB_BASE_URI=https://gitlab.com
PENPOT_GITLAB_CLIENT_ID=<client-id>
PENPOT_GITLAB_CLIENT_SECRET=<client-secret>
```
##### Github
```sh
PENPOT_GITHUB_CLIENT_ID=<client-id>
PENPOT_GITHUB_CLIENT_SECRET=<client-secret>
```
##### LDAP
```sh
PENPOT_LDAP_AUTH_HOST=
PENPOT_LDAP_AUTH_PORT=
PENPOT_LDAP_AUTH_VERSION=3
PENPOT_LDAP_BIND_DN=
PENPOT_LDAP_BIND_PASSWORD=
PENPOT_LDAP_AUTH_SSL=false
PENPOT_LDAP_AUTH_STARTTLS=false
PENPOT_LDAP_AUTH_BASE_DN=
PENPOT_LDAP_AUTH_USER_QUERY=(|(uid=$username)(mail=$username))
PENPOT_LDAP_AUTH_USERNAME_ATTRIBUTE=uid
PENPOT_LDAP_AUTH_EMAIL_ATTRIBUTE=mail
PENPOT_LDAP_AUTH_FULLNAME_ATTRIBUTE=displayName
PENPOT_LDAP_AUTH_AVATAR_ATTRIBUTE=jpegPhoto
```
## Frontend ##
In comparison with backend frontend only has a few number of runtime
configuration options and are located in the
`<dist-root>/js/config.js` file. This file is completly optional; if
it exists, it is loaded by the main index.html.
The `config.js` consists in a bunch of globar variables that are read
by the frontend application on the bootstrap.
### Auth with 3rd party
If any of the following variables are defined, they will enable the
corresponding auth button in the login page
```js
var penpotGoogleClientID = "<google-client-id-here>";
var penpotGitlabClientID = "<gitlab-client-id-here>";
var penpotGithubClientID = "<github-client-id-here>";
var penpotLoginWithLDAP = <true|false>;
```
**NOTE:** The configuration should match the backend configuration for
respective services.
### Demo warning and Demo users
It is possible to display a warning message on a demo environment and
disable/enable demo users:
```js
var penpotDemoWarning = <true|false>;
var penpotAllowDemoUsers = <true|false>;
```
**NOTE:** The configuration for demo users should match the backend
configuration.
## Exporter ##
The exporter application only have a single configuration option and
it can be provided using environment variables in the same way as
backend.
```sh
PENPOT_PUBLIC_URI=http://pubic-domain
```
This environment variable indicates where the exporter can access to
the public frontend application (because it uses special pages from it
to render the shapes in the underlying headless web browser).

45
docs/06-Testing-Guide.md
View file

@ -1,45 +0,0 @@
# Testing guide #
## Backend / Common
You can run the tests directly with:
```bash
~/penpot/backend$ clojure -M:dev:tests
```
Alternatively, you can run them from a REPL. First starting a REPL.
```bash
~/penpot/backend$ scripts/repl
```
And then:
```bash
user=> (run-tests)
user=> (run-tests 'namespace)
user=> (run-tests 'namespace/test)
```
## Frontend
Frontend tests have to be compiled first, and then run with node.
```bash
npx shadow-cljs compile tests && node target/tests.js
```
Or run the watch (that automatically runs the test):
```bash
npx shadow-cljs watch tests
```
## Linter
We can execute the linter for the whole codebase with the following command:
```bash
clj-kondo --lint common:backend/src:frontend/src
```

170
docs/99-Collaborative-Edition.md
View file

@ -1,170 +0,0 @@
# Collaborative Edition & Persistence protocol
This is a collection of design notes for collaborative edition feature
and persistence protocol.
## Persistence Operations
This is a page data structure:
```
{:version 2
:options {}
:rmap
{:id1 :default
:id2 :default
:id3 :id1}
:objects
{:root
{:type :root
:shapes [:id1 :id2]}
:id1
{:type :canvas
:shapes [:id3]}
:id2 {:type :rect}
:id3 {:type :circle}}}
```
This is a potential list of persistent ops:
```
{:type :mod-opts
:operations [<op>, ...]
{:type :add-obj
:id <uuid>
:parent <uuid>
:obj <shape-object>}
{:type :mod-obj
:id <uuid>
:operations [<op>, ...]}
{:type :mov-obj
:id <uuid>
:frame-id <uuid>}
{:type :del-obj
:id <uuid>}
```
This is a potential list of operations:
```
{:type :set
:attr <any>
:val <any>}
{:type :abs-order
:id <uuid>
:index <int>}
{:type :rel-order
:id <uuid>
:loc <one-of:up,down,top,bottom>}
```
## Ephemeral communication (Websocket protocol)
### `join` ###
Sent by clients for notify joining a concrete page-id inside a file.
```clojure
{:type :join
:page-id <id>
:version <number>
}
```
Will cause:
- A posible `:page-changes`.
- Broadcast `:joined` message to all users of the file.
The `joined` message has this aspect:
```clojure
{:type :joined
:page-id <id>
:user-id <id>
}
```
### `who` ###
Sent by clients for request the list of users in the channel.
```clojure
{:type :who}
```
Will cause:
- Reply to the client with the current users list:
```clojure
{:type :who
:users #{<id>,...}}
```
This will be sent all the time user joins or leaves the channel for
maintain the frontend updated with the lates participants. This
message is also sent at the beggining of connection from server to
client.
### `pointer-update` ###
This is sent by client to server and then, broadcasted to the rest of
channel participants.
```clojure
{:type :pointer-update
:page-id <id>
:x <number>
:y <number>
}
```
The server broadcast message will look like:
```clojure
{:type :pointer-update
:user-id <id>
:page-id <id>
:x <number>
:y <number>
}
```
### `:page-snapshot` ###
A message that server sends to client for notify page changes. It can be sent
on `join` and when a page change is commited to the database.
```clojure
{:type :page-snapshot
:user-id <id>
:page-id <id>
:version <number>
:operations [<op>, ...]
}
```
This message is only sent to users that does not perform this change.

BIN
docs/screenshot.png
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 303 KiB

2
exporter/package.json
View file

@ -20,7 +20,7 @@
"xregexp": "^5.0.1"
},
"devDependencies": {
"shadow-cljs": "^2.11.19",
"shadow-cljs": "^2.11.20",
"source-map-support": "^0.5.19"
}
}

1
exporter/scripts/build.sh → exporter/scripts/build
View file

@ -1,6 +1,5 @@
#!/usr/bin/env bash
source ~/.bashrc
set -ex
yarn install

17
exporter/scripts/wait-and-start.sh
View file

@ -1,16 +1,5 @@
#!/usr/bin/env bash
set -e
wait_file() {
local file="$1"; shift
local wait_seconds="${1:-10}"; shift # 10 seconds as default timeout
until test $((wait_seconds--)) -eq 0 -o -f "$file" ; do sleep 1; done
((++wait_seconds))
}
wait_file "target/app.js" 120 && {
node target/app.js
}
bb -i '(babashka.wait/wait-for-port "localhost" 9630)';
bb -i '(babashka.wait/wait-for-path "target/app.js")';
node target/app.js

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