github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-08-01 19:06:18 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/develop' into main

Browse Source
This commit is contained in:
Andrey Antukh 2020-12-11 15:46:01 +01:00
commit 4903d26038
345 changed files with 14058 additions and 8649 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
.clj-kondo/config.edn Normal file
View File

@ -0,0 +1,29 @@
{:lint-as {potok.core/reify clojure.core/reify
promesa.core/let clojure.core/let
app.db/with-atomic clojure.core/with-open}
:output
{:exclude-files ["data_readers.clj"]}
:linters
{:unsorted-required-namespaces
{:level :warning}
:unresolved-namespace
{:level :warning
:exclude [data_readers]}
:single-key-in
{:level :warning}
:unused-binding
{:exclude-destructured-as true
:exclude-destructured-keys-in-fn-args false
}
:unresolved-symbol
{:exclude ['(app.services.mutations/defmutation)
'(app.services.queries/defquery)
'(app.util.dispatcher/defservice)
'(mount.core/defstate)
]}}}

4
.gitignore vendored
View File

@ -25,8 +25,10 @@ node_modules
/frontend/resources/public/* /frontend/resources/public/*
/exporter/target /exporter/target
/exporter/.shadow-cljs /exporter/.shadow-cljs
/docker/testenv/bundle /docker/images/bundle
/.clj-kondo/.cache
/bundle* /bundle*
/media /media
/deploy /deploy
/web /web
/_dump

2
README.md
View File

@ -8,7 +8,7 @@
# PENPOT # # 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 comming early 2021. Alpha release is close! 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](https://raw.githubusercontent.com/penpot/penpot/develop/docs/screenshot.png) ![PENPOT](https://raw.githubusercontent.com/penpot/penpot/develop/docs/screenshot.png)

9
backend/deps.edn
View File

@ -4,6 +4,7 @@
"jcenter" {:url "https://jcenter.bintray.com/"}} "jcenter" {:url "https://jcenter.bintray.com/"}}
:deps :deps
{org.clojure/clojure {:mvn/version "1.10.1"} {org.clojure/clojure {:mvn/version "1.10.1"}
org.clojure/clojurescript {:mvn/version "1.10.773"}
org.clojure/data.json {:mvn/version "1.0.0"} org.clojure/data.json {:mvn/version "1.0.0"}
org.clojure/core.async {:mvn/version "1.3.610"} org.clojure/core.async {:mvn/version "1.3.610"}
@ -33,14 +34,14 @@
org.postgresql/postgresql {:mvn/version "42.2.16"} org.postgresql/postgresql {:mvn/version "42.2.16"}
com.zaxxer/HikariCP {:mvn/version "3.4.5"} com.zaxxer/HikariCP {:mvn/version "3.4.5"}
funcool/log4j2-clojure {:mvn/version "2020.11.23-1"}
funcool/datoteka {:mvn/version "1.2.0"} funcool/datoteka {:mvn/version "1.2.0"}
funcool/promesa {:mvn/version "5.1.0"} funcool/promesa {:mvn/version "5.1.0"}
funcool/cuerdas {:mvn/version "2020.03.26-3"} funcool/cuerdas {:mvn/version "2020.03.26-3"}
buddy/buddy-core {:mvn/version "1.9.0"}
buddy/buddy-core {:mvn/version "1.8.0"} buddy/buddy-hashers {:mvn/version "1.7.0"}
buddy/buddy-hashers {:mvn/version "1.6.0"} buddy/buddy-sign {:mvn/version "3.3.0"}
buddy/buddy-sign {:mvn/version "3.2.0"}
lambdaisland/uri {:mvn/version "1.4.54" lambdaisland/uri {:mvn/version "1.4.54"
:exclusions [org.clojure/data.json]} :exclusions [org.clojure/data.json]}

8
backend/resources/emails-mjml/change-email/en.mjml
View File

@ -45,10 +45,10 @@
<mj-section padding="0"> <mj-section padding="0">
<mj-column> <mj-column>
<mj-social icon-size="24px" mode="horizontal"> <mj-social icon-size="24px" mode="horizontal">
<mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://uxbox.io/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://penpot.app/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpot" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpotapp" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/penpot/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/penpotapp/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" />
</mj-social> </mj-social>
</mj-column> </mj-column>

8
backend/resources/emails-mjml/invite-to-team/en.mjml
View File

@ -38,10 +38,10 @@
<mj-section padding="0"> <mj-section padding="0">
<mj-column> <mj-column>
<mj-social icon-size="24px" mode="horizontal"> <mj-social icon-size="24px" mode="horizontal">
<mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://uxbox.io/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://penpot.app/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpot" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpotapp" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/penpot/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/penpotapp/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" />
</mj-social> </mj-social>
</mj-column> </mj-column>

8
backend/resources/emails-mjml/password-recovery/en.mjml
View File

@ -47,10 +47,10 @@
<mj-section padding="0"> <mj-section padding="0">
<mj-column> <mj-column>
<mj-social icon-size="24px" mode="horizontal"> <mj-social icon-size="24px" mode="horizontal">
<mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://uxbox.io/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://penpot.app/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpot" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpotapp" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/penpot/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/penpotapp/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" />
</mj-social> </mj-social>
</mj-column> </mj-column>

8
backend/resources/emails-mjml/register/en.mjml
View File

@ -44,10 +44,10 @@
<mj-section padding="0"> <mj-section padding="0">
<mj-column> <mj-column>
<mj-social icon-size="24px" mode="horizontal"> <mj-social icon-size="24px" mode="horizontal">
<mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://uxbox.io/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-uxbox.png" href="https://penpot.app/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpot" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-twitter.png" href="https://twitter.com/penpotapp" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-github.png" href="https://github.com/penpot/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/uxbox/" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-instagram.png" href="https://instagram.com/penpotapp/" padding="0 8px" />
<mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" /> <mj-social-element src="{{ public-uri }}/images/email/logo-taiga.png" href="https://tree.taiga.io/project/uxbox" padding="0 8px" />
</mj-social> </mj-social>
</mj-column> </mj-column>

4
backend/resources/emails/change-email/en.html
View File

@ -330,7 +330,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://twitter.com/penpot" target="_blank"> <a href="https://twitter.com/penpotapp" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>
@ -370,7 +370,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://instagram.com/penpot/" target="_blank"> <a href="https://instagram.com/penpotapp/" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>

4
backend/resources/emails/invite-to-team/en.html
View File

@ -320,7 +320,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://twitter.com/penpot" target="_blank"> <a href="https://twitter.com/penpotapp" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>
@ -360,7 +360,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://instagram.com/penpot/" target="_blank"> <a href="https://instagram.com/penpotapp/" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>

4
backend/resources/emails/password-recovery/en.html
View File

@ -325,7 +325,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://twitter.com/penpot" target="_blank"> <a href="https://twitter.com/penpotapp" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>
@ -365,7 +365,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://instagram.com/penpot/" target="_blank"> <a href="https://instagram.com/penpotapp/" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>

4
backend/resources/emails/register/en.html
View File

@ -320,7 +320,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://twitter.com/penpot" target="_blank"> <a href="https://twitter.com/penpotapp" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-twitter.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>
@ -360,7 +360,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="border-radius:3px;width:24px;">
<tr> <tr>
<td style="font-size:0;height:24px;vertical-align:middle;width:24px;"> <td style="font-size:0;height:24px;vertical-align:middle;width:24px;">
<a href="https://instagram.com/penpot/" target="_blank"> <a href="https://instagram.com/penpotapp/" target="_blank">
<img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" /> <img height="24" src="{{ public-uri }}/images/email/logo-instagram.png" style="border-radius:3px;display:block;" width="24" />
</a> </a>
</td> </td>

10
backend/resources/log4j2.xml
View File

@ -12,6 +12,10 @@
</Policies> </Policies>
<DefaultRolloverStrategy max="9"/> <DefaultRolloverStrategy max="9"/>
</RollingFile> </RollingFile>
<CljFn name="error-reporter" ns="app.error-reporter" fn="enqueue">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
</CljFn>
</Appenders> </Appenders>
<Loggers> <Loggers>
@ -23,13 +27,17 @@
<AppenderRef ref="console"/> <AppenderRef ref="console"/>
</Logger> </Logger>
<Logger name="app.error-reporter" level="debug" additivity="false">
<AppenderRef ref="console"/>
</Logger>
<Logger name="app" level="debug" additivity="false"> <Logger name="app" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" /> <AppenderRef ref="main" level="debug" />
<AppenderRef ref="error-reporter" level="error" />
</Logger> </Logger>
<Root level="info"> <Root level="info">
<AppenderRef ref="main" /> <AppenderRef ref="main" />
<!-- <AppenderRef ref="console" /> -->
</Root> </Root>
</Loggers> </Loggers>
</Configuration> </Configuration>

2
backend/scripts/build.sh
View File

@ -47,7 +47,7 @@ if [ -f ./environ ]; then
fi fi
set -x set -x
exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main exec \$JAVA_CMD \$JVM_OPTS -Dapp.enable-asserts=false -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
EOF EOF
chmod +x ./target/dist/run.sh chmod +x ./target/dist/run.sh

9
backend/src/app/cli/fixtures.clj
View File

@ -10,17 +10,16 @@
(ns app.cli.fixtures (ns app.cli.fixtures
"A initial fixtures." "A initial fixtures."
(:require (:require
[clojure.tools.logging :as log]
[mount.core :as mount]
[buddy.hashers :as hashers]
[app.common.data :as d]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.migrations] [app.migrations]
[app.services.mutations.profile :as profile] [app.services.mutations.profile :as profile]
[app.util.blob :as blob])) [app.util.blob :as blob]
[buddy.hashers :as hashers]
[clojure.tools.logging :as log]
[mount.core :as mount]))
(defn- mk-uuid (defn- mk-uuid
[prefix & args] [prefix & args]

30
backend/src/app/cli/media_loader.clj
View File

@ -5,27 +5,27 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.cli.media-loader (ns app.cli.media-loader
"Media libraries importer (command line helper)." "Media libraries importer (command line helper)."
(:require #_(:require
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[clojure.java.io :as io]
[mount.core :as mount]
[datoteka.core :as fs]
[app.config]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db]
[app.media]
[app.media-storage]
[app.migrations]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.services.mutations.projects :as projects] [app.config]
[app.db :as db]
[app.media-storage]
[app.media]
[app.migrations]
[app.services.mutations.files :as files] [app.services.mutations.files :as files]
[app.services.mutations.media :as media]) [app.services.mutations.media :as media]
(:import [app.services.mutations.projects :as projects]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[datoteka.core :as fs]
[mount.core :as mount])
#_(:import
java.io.PushbackReader)) java.io.PushbackReader))
;; --- Constants & Helpers ;; --- Constants & Helpers

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

@ -10,14 +10,13 @@
(ns app.config (ns app.config
"A configuration management." "A configuration management."
(:require (:require
[app.common.spec :as us]
[app.common.version :as v]
[app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str] [cuerdas.core :as str]
[environ.core :refer [env]] [environ.core :refer [env]]
[mount.core :refer [defstate]] [mount.core :refer [defstate]]))
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.util.time :as dt]))
(def defaults (def defaults
{:http-server-port 6060 {:http-server-port 6060
@ -41,6 +40,8 @@
:smtp-default-reply-to "no-reply@example.com" :smtp-default-reply-to "no-reply@example.com"
:smtp-default-from "no-reply@example.com" :smtp-default-from "no-reply@example.com"
:host "devenv"
:allow-demo-users true :allow-demo-users true
:registration-enabled true :registration-enabled true
:registration-domain-whitelist "" :registration-domain-whitelist ""
@ -50,7 +51,7 @@
;; modification in order to make the file ellegible for ;; modification in order to make the file ellegible for
;; trimming. The value only supports s(econds) m(inutes) and ;; trimming. The value only supports s(econds) m(inutes) and
;; h(ours) as time unit. ;; h(ours) as time unit.
:file-trimming-max-age "72h" :file-trimming-threshold "72h"
;; LDAP auth disabled by default. Set ldap-auth-host to enable ;; LDAP auth disabled by default. Set ldap-auth-host to enable
;:ldap-auth-host "ldap.mysupercompany.com" ;:ldap-auth-host "ldap.mysupercompany.com"
@ -79,6 +80,9 @@
(s/def ::media-uri ::us/string) (s/def ::media-uri ::us/string)
(s/def ::media-directory ::us/string) (s/def ::media-directory ::us/string)
(s/def ::secret-key ::us/string) (s/def ::secret-key ::us/string)
(s/def ::host ::us/string)
(s/def ::error-report-webhook ::us/string)
(s/def ::smtp-enabled ::us/boolean) (s/def ::smtp-enabled ::us/boolean)
(s/def ::smtp-default-reply-to ::us/email) (s/def ::smtp-default-reply-to ::us/email)
(s/def ::smtp-default-from ::us/email) (s/def ::smtp-default-from ::us/email)
@ -94,7 +98,9 @@
(s/def ::debug-humanize-transit ::us/boolean) (s/def ::debug-humanize-transit ::us/boolean)
(s/def ::public-uri ::us/string) (s/def ::public-uri ::us/string)
(s/def ::backend-uri ::us/string) (s/def ::backend-uri ::us/string)
(s/def ::image-process-max-threads ::us/integer) (s/def ::image-process-max-threads ::us/integer)
(s/def ::file-trimming-threshold ::dt/duration)
(s/def ::google-client-id ::us/string) (s/def ::google-client-id ::us/string)
(s/def ::google-client-secret ::us/string) (s/def ::google-client-secret ::us/string)
@ -115,7 +121,6 @@
(s/def ::ldap-auth-email-attribute ::us/string) (s/def ::ldap-auth-email-attribute ::us/string)
(s/def ::ldap-auth-fullname-attribute ::us/string) (s/def ::ldap-auth-fullname-attribute ::us/string)
(s/def ::ldap-auth-avatar-attribute ::us/string) (s/def ::ldap-auth-avatar-attribute ::us/string)
(s/def ::file-trimming-threshold ::dt/duration)
(s/def ::config (s/def ::config
(s/keys :opt-un [::http-server-cors (s/keys :opt-un [::http-server-cors
@ -135,6 +140,7 @@
::assets-uri ::assets-uri
::media-directory ::media-directory
::media-uri ::media-uri
::error-report-webhook
::secret-key ::secret-key
::smtp-default-from ::smtp-default-from
::smtp-default-reply-to ::smtp-default-reply-to
@ -145,7 +151,8 @@
::smtp-password ::smtp-password
::smtp-tls ::smtp-tls
::smtp-ssl ::smtp-ssl
::file-trimming-max-age ::host
::file-trimming-threshold
::debug-humanize-transit ::debug-humanize-transit
::allow-demo-users ::allow-demo-users
::registration-enabled ::registration-enabled
@ -198,6 +205,9 @@
(def default-deletion-delay (def default-deletion-delay
(dt/duration {:hours 48})) (dt/duration {:hours 48}))
(def version
(delay (v/parse "%version%")))
(defn smtp (defn smtp
[cfg] [cfg]
{:host (:smtp-host cfg "localhost") {:host (:smtp-host cfg "localhost")

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

@ -13,19 +13,15 @@
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.config :as cfg] [app.config :as cfg]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.data :as data]
[app.util.time :as dt] [app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[clojure.data.json :as json] [clojure.data.json :as json]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.string :as str] [clojure.string :as str]
[clojure.tools.logging :as log]
[lambdaisland.uri :refer [uri]]
[mount.core :as mount :refer [defstate]] [mount.core :as mount :refer [defstate]]
[next.jdbc :as jdbc] [next.jdbc :as jdbc]
[next.jdbc.date-time :as jdbc-dt] [next.jdbc.date-time :as jdbc-dt]
[next.jdbc.optional :as jdbc-opt] [next.jdbc.optional :as jdbc-opt]
[next.jdbc.result-set :as jdbc-rs]
[next.jdbc.sql :as jdbc-sql] [next.jdbc.sql :as jdbc-sql]
[next.jdbc.sql.builder :as jdbc-bld]) [next.jdbc.sql.builder :as jdbc-bld])
(:import (:import
@ -34,8 +30,8 @@
com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
java.sql.Connection java.sql.Connection
java.sql.Savepoint java.sql.Savepoint
org.postgresql.jdbc.PgArray
org.postgresql.geometric.PGpoint org.postgresql.geometric.PGpoint
org.postgresql.jdbc.PgArray
org.postgresql.util.PGInterval org.postgresql.util.PGInterval
org.postgresql.util.PGobject)) org.postgresql.util.PGobject))
@ -83,6 +79,8 @@
(jdbc-dt/read-as-instant) (jdbc-dt/read-as-instant)
(HikariDataSource. dsc))) (HikariDataSource. dsc)))
(declare pool)
(defstate pool (defstate pool
:start (create-pool cfg/config) :start (create-pool cfg/config)
:stop (.close pool)) :stop (.close pool))
@ -221,15 +219,6 @@
:else :else
(ex/raise :type :not-implemented))) (ex/raise :type :not-implemented)))
(defn decode-pgobject
[^PGobject obj]
(let [typ (.getType obj)
val (.getValue obj)]
(if (or (= typ "json")
(= typ "jsonb"))
(json/read-str val)
val)))
(defn decode-json-pgobject (defn decode-json-pgobject
[^PGobject o] [^PGobject o]
(let [typ (.getType o) (let [typ (.getType o)

9
backend/src/app/emails.clj
View File

@ -10,14 +10,11 @@
(ns app.emails (ns app.emails
"Main api for send emails." "Main api for send emails."
(:require (:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[app.config :as cfg]
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.config :as cfg]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.emails :as emails])) [app.util.emails :as emails]
[clojure.spec.alpha :as s]))
;; --- Defaults ;; --- Defaults

83
backend/src/app/error_reporter.clj Normal file
View File

@ -0,0 +1,83 @@
;; 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 Andrey Antukh <niwi@niwi.nz>
(ns app.error-reporter
"A mattermost integration for error reporting."
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.tasks :as tasks]
[app.util.async :as aa]
[app.worker :as wrk]
[app.util.http :as http]
[clojure.core.async :as a]
[clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str]
[mount.core :as mount :refer [defstate]]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce enqueue identity)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- send-to-mattermost!
[log-event]
(try
(let [text (str/fmt "Unhandled exception: `host='%s'`, `version=%s`.\n@channel ⇊\n```%s\n```"
(:host cfg/config)
(:full @cfg/version)
(str log-event))
rsp (http/send! {:uri (:error-reporter-webhook cfg/config)
:method :post
:headers {"content-type" "application/json"}
:body (json/write-str {:text text})})]
(when (not= (:status rsp) 200)
(log/warnf "Error reporting webhook replying with unexpected status: %s\n%s"
(:status rsp)
(pr-str rsp))))
(catch Exception e
(log/warnf e "Unexpected exception on error reporter."))))
(defn- send!
[val]
(aa/thread-call wrk/executor (partial send-to-mattermost! val)))
(defn- start
[]
(let [qch (a/chan (a/sliding-buffer 128))]
(log/info "Starting error reporter loop.")
;; Only enable when a valid URL is provided.
(when (:error-reporter-webhook cfg/config)
(alter-var-root #'enqueue (constantly #(a/>!! qch %)))
(a/go-loop []
(let [val (a/<! qch)]
(if (nil? val)
(do
(log/info "Closing error reporting loop.")
(alter-var-root #'enqueue (constantly identity)))
(do
(a/<! (send! val))
(recur))))))
qch))
(defstate reporter
:start (start)
:stop (a/close! reporter))

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

@ -9,31 +9,29 @@
(ns app.http (ns app.http
(:require (:require
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[reitit.ring :as rring]
[ring.adapter.jetty9 :as jetty]
[app.config :as cfg] [app.config :as cfg]
[app.http.auth :as auth] [app.http.auth :as auth]
[app.http.auth.gitlab :as gitlab] [app.http.auth.gitlab :as gitlab]
[app.http.auth.google :as google] [app.http.auth.google :as google]
[app.http.auth.ldap :as ldap] [app.http.auth.ldap :as ldap]
[app.http.debug :as debug]
[app.http.errors :as errors] [app.http.errors :as errors]
[app.http.handlers :as handlers] [app.http.handlers :as handlers]
[app.http.middleware :as middleware] [app.http.middleware :as middleware]
[app.http.session :as session] [app.http.session :as session]
[app.http.ws :as ws] [app.http.ws :as ws]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.services.notifications :as usn])) [clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[reitit.ring :as rring]
[ring.adapter.jetty9 :as jetty]))
(defn- create-router (defn- create-router
[] []
(rring/router (rring/router
[["/metrics" {:get mtx/dump}] [["/metrics" {:get mtx/dump}]
["/api" {:middleware [[middleware/format-response-body] ["/api" {:middleware [[middleware/format-response-body]
[middleware/errors errors/handle]
[middleware/parse-request-body] [middleware/parse-request-body]
[middleware/errors errors/handle]
[middleware/params] [middleware/params]
[middleware/multipart-params] [middleware/multipart-params]
[middleware/keyword-params] [middleware/keyword-params]

16
backend/src/app/http/auth.clj
View File

@ -9,20 +9,18 @@
(ns app.http.auth (ns app.http.auth
(:require (:require
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm])) [app.services.mutations :as sm]))
(defn login-handler (defn login-handler
[req] [req]
(let [data (:body-params req) (let [data (:body-params req)
uagent (get-in req [:headers "user-agent"])] uagent (get-in req [:headers "user-agent"])
(let [profile (sm/handle (assoc data ::sm/type :login)) profile (sm/handle (assoc data ::sm/type :login))
id (session/create (:id profile) uagent)] id (session/create (:id profile) uagent)]
{:status 200 {:status 200
:cookies (session/cookies id) :cookies (session/cookies id)
:body profile}))) :body profile}))
(defn logout-handler (defn logout-handler
[req] [req]

6
backend/src/app/http/auth/gitlab.clj
View File

@ -11,7 +11,6 @@
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.tokens :as tokens] [app.services.tokens :as tokens]
@ -21,7 +20,6 @@
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[lambdaisland.uri :as uri])) [lambdaisland.uri :as uri]))
(def default-base-gitlab-uri "https://gitlab.com") (def default-base-gitlab-uri "https://gitlab.com")
(def scope "read_user") (def scope "read_user")
@ -100,7 +98,7 @@
nil)))) nil))))
(defn auth (defn auth
[req] [_req]
(let [token (tokens/generate (let [token (tokens/generate
{:iss :gitlab-oauth {:iss :gitlab-oauth
:exp (dt/in-future "15m")}) :exp (dt/in-future "15m")})
@ -119,7 +117,7 @@
(defn callback (defn callback
[req] [req]
(let [token (get-in req [:params :state]) (let [token (get-in req [:params :state])
tdata (tokens/verify token {:iss :gitlab-oauth}) _ (tokens/verify token {:iss :gitlab-oauth})
info (some-> (get-in req [:params :code]) info (some-> (get-in req [:params :code])
(get-access-token) (get-access-token)
(get-user-info))] (get-user-info))]

8
backend/src/app/http/auth/google.clj
View File

@ -11,7 +11,6 @@
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.tokens :as tokens] [app.services.tokens :as tokens]
@ -84,9 +83,8 @@
nil)))) nil))))
(defn auth (defn auth
[req] [_req]
(let [token (tokens/generate {:iss :google-oauth (let [token (tokens/generate {:iss :google-oauth :exp (dt/in-future "15m")})
:exp (dt/in-future "15m")})
params {:scope scope params {:scope scope
:access_type "offline" :access_type "offline"
:include_granted_scopes true :include_granted_scopes true
@ -104,7 +102,7 @@
(defn callback (defn callback
[req] [req]
(let [token (get-in req [:params :state]) (let [token (get-in req [:params :state])
tdata (tokens/verify token {:iss :google-oauth}) _ (tokens/verify token {:iss :google-oauth})
info (some-> (get-in req [:params :code]) info (some-> (get-in req [:params :code])
(get-access-token) (get-access-token)
(get-user-info))] (get-user-info))]

29
backend/src/app/http/auth/ldap.clj
View File

@ -1,18 +1,29 @@
;; 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.http.auth.ldap (ns app.http.auth.ldap
(:require (:require
[clj-ldap.client :as client] [app.common.exceptions :as ex]
[clojure.set :as set] [app.config :as cfg]
[mount.core :refer [defstate]] [app.http.session :as session]
[app.common.exceptions :as ex] [app.services.mutations :as sm]
[app.config :as cfg] [clj-ldap.client :as client]
[app.services.mutations :as sm] [clojure.set :as set]
[app.http.session :as session] [clojure.string]
[clojure.tools.logging :as log])) [clojure.tools.logging :as log]
[mount.core :refer [defstate]]))
(defn replace-several [s & {:as replacements}] (defn replace-several [s & {:as replacements}]
(reduce-kv clojure.string/replace s replacements)) (reduce-kv clojure.string/replace s replacements))
(declare *ldap-pool)
(defstate *ldap-pool (defstate *ldap-pool
:start (delay :start (delay
(try (try

24
backend/src/app/http/debug.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/.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns app.http.debug
"Debug related handlers."
(:require
[clojure.tools.logging :as log]
[promesa.core :as p]
[app.http.errors :as errors]
[app.http.session :as session]
[app.common.uuid :as uuid]))
(defn emails-list
[req]
{:status 200
:body "Hello world\n"})
(defn email
[req]
{:status 200
:body "Hello world\n"})

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

@ -2,43 +2,55 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz> ;; 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.http.errors (ns app.http.errors
"A errors handling for the http server." "A errors handling for the http server."
(:require (:require
[app.common.exceptions :as ex]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[cuerdas.core :as str] [cuerdas.core :as str]
[app.metrics :as mtx] [expound.alpha :as expound]))
[io.aviso.exception :as e]))
(defmulti handle-exception (defmulti handle-exception
(fn [err & rest] (fn [err & _rest]
(:type (ex-data err)))) (let [edata (ex-data err)]
(or (:type edata)
(class err)))))
(defmethod handle-exception :authorization
[err _]
{:status 403
:body (ex-data err)})
(defmethod handle-exception :validation (defmethod handle-exception :validation
[err req] [err req]
(let [header (get-in req [:headers "accept"]) (let [header (get-in req [:headers "accept"])
response (ex-data err)] edata (ex-data err)]
(cond (cond
(and (str/starts-with? header "text/html") (and (str/starts-with? header "text/html")
(= :spec-validation (:code response))) (= :spec-validation (:code edata)))
{:status 400 {:status 400
:headers {"content-type" "text/html"} :headers {"content-type" "text/html"}
:body (str "<pre style='font-size:16px'>" (:explain response) "</pre>\n")} :body (str "<pre style='font-size:16px'>"
(with-out-str
(:data edata))
"</pre>\n")}
:else :else
{:status 400 {:status 400
:body response}))) :body edata})))
(defmethod handle-exception :ratelimit (defmethod handle-exception :ratelimit
[err req] [_ _]
{:status 429 {:status 429
:headers {"retry-after" 1000} :headers {"retry-after" 1000}
:body ""}) :body ""})
(defmethod handle-exception :not-found (defmethod handle-exception :not-found
[err req] [err _]
(let [response (ex-data err)] (let [response (ex-data err)]
{:status 404 {:status 404
:body response})) :body response}))
@ -48,16 +60,43 @@
(handle-exception (.getCause ^Throwable err) req)) (handle-exception (.getCause ^Throwable err) req))
(defmethod handle-exception :parse (defmethod handle-exception :parse
[err req] [err _]
{:status 400 {:status 400
:body {:type :parse :body {:type :parse
:message (ex-message err)}}) :message (ex-message err)}})
(defn get-context-string
[err request]
(str
"=| uri: " (pr-str (:uri request)) "\n"
"=| method: " (pr-str (:request-method request)) "\n"
"=| path-params: " (pr-str (:path-params request)) "\n"
"=| query-params: " (pr-str (:query-params request)) "\n"
(when-let [bparams (:body-params request)]
(str "=| body-params: " (pr-str bparams) "\n"))
(when (ex/ex-info? err)
(str "=| ex-data: " (pr-str (ex-data err)) "\n"))
"\n"))
(defmethod handle-exception :assertion
[err request]
(let [{:keys [data] :as edata} (ex-data err)]
(log/errorf err
(str "Assertion error\n"
(get-context-string err request)
(with-out-str (expound/printer data))))
{:status 500
:body {:type :internal-error
:message "Assertion error"
:data (ex-data err)}}))
(defmethod handle-exception :default (defmethod handle-exception :default
[err req] [err request]
(log/error "Unhandled exception on request:" (:path req) "\n" (log/errorf err (str "Internal Error\n" (get-context-string err request)))
(with-out-str
(.printStackTrace ^Throwable err (java.io.PrintWriter. *out*))))
{:status 500 {:status 500
:body {:type :internal-error :body {:type :internal-error
:message (ex-message err) :message (ex-message err)

45
backend/src/app/http/handlers.clj
View File

@ -9,6 +9,7 @@
(ns app.http.handlers (ns app.http.handlers
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.emails :as emails] [app.emails :as emails]
[app.http.session :as session] [app.http.session :as session]
@ -28,36 +29,40 @@
:login}) :login})
(defn query-handler (defn query-handler
[req] [{:keys [profile-id] :as request}]
(let [type (keyword (get-in req [:path-params :type])) (let [type (keyword (get-in request [:path-params :type]))
data (merge (:params req) data (assoc (:params request) ::sq/type type)
{::sq/type type}) data (if profile-id
data (cond-> data (assoc data :profile-id profile-id)
(:profile-id req) (assoc :profile-id (:profile-id req)))] (dissoc data :profile-id))]
(if (or (:profile-id req) (contains? unauthorized-services type))
(if (or (uuid? profile-id)
(contains? unauthorized-services type))
{:status 200 {:status 200
:body (sq/handle (with-meta data {:req req}))} :body (sq/handle (with-meta data {:req request}))}
{:status 403 {:status 403
:body {:type :authentication :body {:type :authentication
:code :unauthorized}}))) :code :unauthorized}})))
(defn mutation-handler (defn mutation-handler
[req] [{:keys [profile-id] :as request}]
(let [type (keyword (get-in req [:path-params :type])) (let [type (keyword (get-in request [:path-params :type]))
data (merge (:params req) data (d/merge (:params request)
(:body-params req) (:body-params request)
(:uploads req) (:uploads request)
{::sm/type type}) {::sm/type type})
data (cond-> data data (if profile-id
(:profile-id req) (assoc :profile-id (:profile-id req)))] (assoc data :profile-id profile-id)
(if (or (:profile-id req) (contains? unauthorized-services type)) (dissoc data :profile-id))]
(let [result (sm/handle (with-meta data {:req req}))
(if (or (uuid? profile-id)
(contains? unauthorized-services type))
(let [result (sm/handle (with-meta data {:req request}))
mdata (meta result) mdata (meta result)
resp {:status (if (nil? (seq result)) 204 200) resp {:status (if (nil? (seq result)) 204 200)
:body result}] :body result}]
(cond->> resp (cond->> resp
(:transform-response mdata) ((:transform-response mdata) req))) (:transform-response mdata) ((:transform-response mdata) request)))
{:status 403 {:status 403
:body {:type :authentication :body {:type :authentication
:code :unauthorized}}))) :code :unauthorized}})))

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

@ -5,20 +5,19 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.http.middleware (ns app.http.middleware
(:require (:require
[clojure.tools.logging :as log] [app.common.exceptions :as ex]
[app.config :as cfg]
[app.metrics :as mtx]
[app.util.transit :as t]
[ring.middleware.cookies :refer [wrap-cookies]] [ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]] [ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.multipart-params :refer [wrap-multipart-params]] [ring.middleware.multipart-params :refer [wrap-multipart-params]]
[ring.middleware.params :refer [wrap-params]] [ring.middleware.params :refer [wrap-params]]
[ring.middleware.resource :refer [wrap-resource]] [ring.middleware.resource :refer [wrap-resource]]))
[app.metrics :as mtx]
[app.common.exceptions :as ex]
[app.config :as cfg]
[app.util.transit :as t]))
(defn- wrap-parse-request-body (defn- wrap-parse-request-body
[handler] [handler]
@ -126,13 +125,13 @@
(def development-cors (def development-cors
{:name ::development-cors {:name ::development-cors
:compile (fn [& args] :compile (fn [& _args]
(when *assert* (when *assert*
wrap-development-cors))}) wrap-development-cors))})
(def development-resources (def development-resources
{:name ::development-resources {:name ::development-resources
:compile (fn [& args] :compile (fn [& _args]
(when *assert* (when *assert*
#(wrap-resource % "public")))}) #(wrap-resource % "public")))})

12
backend/src/app/http/ws.clj
View File

@ -10,16 +10,14 @@
(ns app.http.ws (ns app.http.ws
"Web Socket handlers" "Web Socket handlers"
(:require (:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[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]]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.http.session :refer [wrap-session]] [app.http.session :refer [wrap-session]]
[app.services.notifications :as nf])) [app.services.notifications :as nf]
[clojure.spec.alpha :as s]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.params :refer [wrap-params]]))
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::session-id ::us/uuid) (s/def ::session-id ::us/uuid)

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

@ -9,6 +9,8 @@
(ns app.main (ns app.main
(:require (:require
[app.config :as cfg]
[clojure.tools.logging :as log]
[mount.core :as mount])) [mount.core :as mount]))
(defn- enable-asserts (defn- enable-asserts
@ -25,16 +27,16 @@
;; --- Entry point ;; --- Entry point
(defn run (defn run
[params] [_params]
(require 'app.config (require 'app.srepl.server
'app.services
'app.migrations 'app.migrations
'app.worker 'app.worker
'app.media 'app.media
'app.http) 'app.http)
(mount/start)) (mount/start)
(log/infof "Welcome to penpot! Version: '%s'." (:full @cfg/version)))
(defn -main (defn -main
[& args] [& _args]
(run {})) (run {}))

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

@ -10,14 +10,11 @@
(ns app.media (ns app.media
"Media postprocessing." "Media postprocessing."
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm] [app.common.media :as cm]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.media-storage :as mst]
[app.util.http :as http] [app.util.http :as http]
[app.util.storage :as ust]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -25,11 +22,12 @@
[mount.core :refer [defstate]]) [mount.core :refer [defstate]])
(:import (:import
java.io.ByteArrayInputStream java.io.ByteArrayInputStream
java.io.InputStream
java.util.concurrent.Semaphore java.util.concurrent.Semaphore
org.im4java.core.ConvertCmd org.im4java.core.ConvertCmd
org.im4java.core.Info org.im4java.core.IMOperation
org.im4java.core.IMOperation)) org.im4java.core.Info))
(declare semaphore)
(defstate semaphore (defstate semaphore
:start (Semaphore. (:image-process-max-threads cfg/config 1))) :start (Semaphore. (:image-process-max-threads cfg/config 1)))
@ -73,7 +71,7 @@
;; http://www.imagemagick.org/Usage/thumbnails/ ;; http://www.imagemagick.org/Usage/thumbnails/
(defn- generic-process (defn- generic-process
[{:keys [input format quality operation] :as params}] [{:keys [input format operation] :as params}]
(let [{:keys [path mtype]} input (let [{:keys [path mtype]} input
format (or (cm/mtype->format mtype) format) format (or (cm/mtype->format mtype) format)
ext (cm/format->extension format) ext (cm/format->extension format)
@ -160,35 +158,6 @@
;; --- Utility functions ;; --- Utility functions
(defn resolve-urls
[row src dst]
(s/assert map? row)
(if (and src dst)
(let [src (if (vector? src) src [src])
dst (if (vector? dst) dst [dst])
value (get-in row src)]
(if (empty? value)
row
(let [url (ust/public-uri mst/media-storage value)]
(assoc-in row dst (str url)))))
row))
(defn- resolve-uri
[storage row src dst]
(let [src (if (vector? src) src [src])
dst (if (vector? dst) dst [dst])
value (get-in row src)]
(if (empty? value)
row
(let [url (ust/public-uri mst/media-storage value)]
(assoc-in row dst (str url))))))
(defn resolve-media-uris
[row & pairs]
(us/assert map? row)
(us/assert (s/coll-of vector?) pairs)
(reduce #(resolve-uri mst/media-storage %1 (nth %2 0) (nth %2 1)) row pairs))
(defn validate-media-type (defn validate-media-type
[media-type] [media-type]
(when-not (cm/valid-media-types media-type) (when-not (cm/valid-media-types media-type)
@ -196,6 +165,11 @@
:code :media-type-not-allowed :code :media-type-not-allowed
:hint "Seems like you are uploading an invalid media object"))) :hint "Seems like you are uploading an invalid media object")))
;; TODO: rewrite using jetty http client instead of jvm
;; builtin (because builtin http client uses a lot of memory for the
;; same operation.
(defn download-media-object (defn download-media-object
[url] [url]
(let [result (http/get! url {:as :byte-array}) (let [result (http/get! url {:as :byte-array})

13
backend/src/app/media_storage.clj
View File

@ -5,24 +5,25 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2017-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.media-storage (ns app.media-storage
"A media storage impl for app." "A media storage impl for app."
(:require (:require
[mount.core :refer [defstate]] [app.config :refer [config]]
[clojure.java.io :as io]
[cuerdas.core :as str]
[datoteka.core :as fs]
[app.util.storage :as ust] [app.util.storage :as ust]
[app.config :refer [config]])) [mount.core :refer [defstate]]))
;; --- State ;; --- State
(declare assets-storage)
(defstate assets-storage (defstate assets-storage
:start (ust/create {:base-path (:assets-directory config) :start (ust/create {:base-path (:assets-directory config)
:base-uri (:assets-uri config)})) :base-uri (:assets-uri config)}))
(declare media-storage)
(defstate media-storage (defstate media-storage
:start (ust/create {:base-path (:media-directory config) :start (ust/create {:base-path (:media-directory config)
:base-uri (:media-uri config) :base-uri (:media-uri config)

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

@ -8,9 +8,6 @@
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.metrics (ns app.metrics
(:require
[clojure.tools.logging :as log]
[cuerdas.core :as str])
(:import (:import
io.prometheus.client.CollectorRegistry io.prometheus.client.CollectorRegistry
io.prometheus.client.Counter io.prometheus.client.Counter
@ -172,7 +169,7 @@
(assoc mdata ::summary-original original))))))) (assoc mdata ::summary-original original)))))))
(defn dump (defn dump
[& args] [& _args]
(let [samples (.metricFamilySamples ^CollectorRegistry registry) (let [samples (.metricFamilySamples ^CollectorRegistry registry)
writer (StringWriter.)] writer (StringWriter.)]
(TextFormat/write004 writer samples) (TextFormat/write004 writer samples)

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

@ -9,11 +9,10 @@
(ns app.migrations (ns app.migrations
(:require (:require
[mount.core :as mount :refer [defstate]]
[app.db :as db] [app.db :as db]
[app.config :as cfg]
[app.migrations.migration-0023 :as mg0023] [app.migrations.migration-0023 :as mg0023]
[app.util.migrations :as mg])) [app.util.migrations :as mg]
[mount.core :as mount :refer [defstate]]))
(def +migrations+ (def +migrations+
{:name "uxbox-main" {:name "uxbox-main"
@ -110,6 +109,15 @@
{:name "0031-add-conversation-related-tables" {:name "0031-add-conversation-related-tables"
:fn (mg/resource "app/migrations/sql/0031-add-conversation-related-tables.sql")} :fn (mg/resource "app/migrations/sql/0031-add-conversation-related-tables.sql")}
{:name "0032-del-unused-tables"
:fn (mg/resource "app/migrations/sql/0032-del-unused-tables.sql")}
{:name "0033-mod-comment-thread-table"
:fn (mg/resource "app/migrations/sql/0033-mod-comment-thread-table.sql")}
{:name "0034-mod-profile-table-add-props-field"
:fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
]}) ]})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

3
backend/src/app/migrations/sql/0032-del-unused-tables.sql Normal file
View File

@ -0,0 +1,3 @@
DROP TABLE color;
DROP TABLE page_change;
DROP TABLE page_version;

2
backend/src/app/migrations/sql/0033-mod-comment-thread-table.sql Normal file
View File

@ -0,0 +1,2 @@
ALTER TABLE comment_thread
ADD COLUMN page_name text NULL;

1
backend/src/app/migrations/sql/0034-mod-profile-table-add-props-field.sql Normal file
View File

@ -0,0 +1 @@
ALTER TABLE profile ADD COLUMN props jsonb NULL DEFAULT NULL;

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

@ -7,13 +7,9 @@
(ns app.redis (ns app.redis
(:refer-clojure :exclude [run!]) (:refer-clojure :exclude [run!])
(:require (:require
[clojure.tools.logging :as log]
[lambdaisland.uri :refer [uri]]
[mount.core :as mount :refer [defstate]]
[app.common.exceptions :as ex]
[app.config :as cfg] [app.config :as cfg]
[app.util.data :as data] [app.util.redis :as redis]
[app.util.redis :as redis]) [mount.core :as mount :refer [defstate]])
(:import (:import
java.lang.AutoCloseable)) java.lang.AutoCloseable))
@ -24,10 +20,14 @@
(let [uri (:redis-uri config "redis://redis/0")] (let [uri (:redis-uri config "redis://redis/0")]
(redis/client uri))) (redis/client uri)))
(declare client)
(defstate client (defstate client
:start (create-client cfg/config) :start (create-client cfg/config)
:stop (.close ^AutoCloseable client)) :stop (.close ^AutoCloseable client))
(declare conn)
(defstate conn (defstate conn
:start (redis/connect client) :start (redis/connect client)
:stop (.close ^AutoCloseable conn)) :stop (.close ^AutoCloseable conn))

43
backend/src/app/services.clj Normal file
View File

@ -0,0 +1,43 @@
;; 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.services
"A initialization of services."
(:require
[app.services.middleware :as middleware]
[app.util.dispatcher :as uds]
[mount.core :as mount :refer [defstate]]))
;; --- Initialization
(defn- load-query-services
[]
(require 'app.services.queries.projects)
(require 'app.services.queries.files)
(require 'app.services.queries.comments)
(require 'app.services.queries.profile)
(require 'app.services.queries.recent-files)
(require 'app.services.queries.viewer))
(defn- load-mutation-services
[]
(require 'app.services.mutations.demo)
(require 'app.services.mutations.media)
(require 'app.services.mutations.projects)
(require 'app.services.mutations.files)
(require 'app.services.mutations.comments)
(require 'app.services.mutations.profile)
(require 'app.services.mutations.viewer)
(require 'app.services.mutations.verify-token))
(defstate query-services
:start (load-query-services))
(defstate mutation-services
:start (load-mutation-services))

32
backend/src/app/services/init.clj
View File

@ -7,34 +7,4 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.init (ns app.services.init)
"A initialization of services."
(:require
[mount.core :as mount :refer [defstate]]))
(defn- load-query-services
[]
(require 'app.services.queries.media)
(require 'app.services.queries.projects)
(require 'app.services.queries.files)
(require 'app.services.queries.comments)
(require 'app.services.queries.profile)
(require 'app.services.queries.recent-files)
(require 'app.services.queries.viewer))
(defn- load-mutation-services
[]
(require 'app.services.mutations.demo)
(require 'app.services.mutations.media)
(require 'app.services.mutations.projects)
(require 'app.services.mutations.files)
(require 'app.services.mutations.comments)
(require 'app.services.mutations.profile)
(require 'app.services.mutations.viewer)
(require 'app.services.mutations.verify-token))
(defstate query-services
:start (load-query-services))
(defstate mutation-services
:start (load-mutation-services))

10
backend/src/app/services/middleware.clj
View File

@ -10,13 +10,11 @@
(ns app.services.middleware (ns app.services.middleware
"Common middleware for services." "Common middleware for services."
(:require (:require
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[expound.alpha :as expound]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.metrics :as mtx])) [app.metrics :as mtx]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(defn wrap-spec (defn wrap-spec
[handler] [handler]
@ -45,7 +43,7 @@
(defn- get-prefix (defn- get-prefix
[nsname] [nsname]
(let [[a b c] (str/split nsname ".")] (let [[_ _ c] (str/split nsname ".")]
c)) c))
(defn wrap-metrics (defn wrap-metrics

82
backend/src/app/services/mutations/comments.clj
View File

@ -9,32 +9,27 @@
(ns app.services.mutations.comments (ns app.services.mutations.comments
(:require (:require
[clojure.spec.alpha :as s]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.queries.projects :as proj]
[app.services.queries.files :as files]
[app.services.queries.comments :as comments] [app.services.queries.comments :as comments]
[app.tasks :as tasks] [app.services.queries.files :as files]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.storage :as ust] [app.util.time :as dt]
[app.util.transit :as t] [clojure.spec.alpha :as s]))
[app.util.time :as dt]))
;; --- Mutation: Create Comment Thread ;; --- Mutation: Create Comment Thread
(declare upsert-comment-thread-status!) (declare upsert-comment-thread-status!)
(declare create-comment-thread) (declare create-comment-thread)
(declare retrieve-page-name)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::profile-id ::us/uuid) (s/def ::profile-id ::us/uuid)
(s/def ::position ::us/point) (s/def ::position ::us/point)
(s/def ::content ::us/string) (s/def ::content ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::create-comment-thread (s/def ::create-comment-thread
(s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id])) (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
@ -53,25 +48,28 @@
(defn- create-comment-thread* (defn- create-comment-thread*
[conn {:keys [profile-id file-id page-id position content] :as params}] [conn {:keys [profile-id file-id page-id position content] :as params}]
(let [seqn (retrieve-next-seqn conn file-id) (let [seqn (retrieve-next-seqn conn file-id)
now (dt/now) now (dt/now)
pname (retrieve-page-name conn params)
thread (db/insert! conn :comment-thread thread (db/insert! conn :comment-thread
{:file-id file-id {:file-id file-id
:owner-id profile-id :owner-id profile-id
:participants (db/tjson #{profile-id}) :participants (db/tjson #{profile-id})
:page-name pname
:page-id page-id :page-id page-id
:created-at now :created-at now
:modified-at now :modified-at now
:seqn seqn :seqn seqn
:position (db/pgpoint position)}) :position (db/pgpoint position)})]
;; Create a comment entry
comment (db/insert! conn :comment
{:thread-id (:id thread) ;; Create a comment entry
:owner-id profile-id (db/insert! conn :comment
:created-at now {:thread-id (:id thread)
:modified-at now :owner-id profile-id
:content content})] :created-at now
:modified-at now
:content content})
;; Make the current thread as read. ;; Make the current thread as read.
(upsert-comment-thread-status! conn profile-id (:id thread)) (upsert-comment-thread-status! conn profile-id (:id thread))
@ -81,10 +79,7 @@
{:comment-thread-seqn seqn} {:comment-thread-seqn seqn}
{:id file-id}) {:id file-id})
(-> (assoc thread (select-keys thread [:id :file-id :page-id])))
:content content
:comment comment)
(comments/decode-row))))
(defn- create-comment-thread (defn- create-comment-thread
[conn params] [conn params]
@ -104,6 +99,12 @@
:else res)))) :else res))))
(defn- retrieve-page-name
[conn {:keys [file-id page-id]}]
(let [{:keys [data]} (db/get-by-id conn :file file-id)
data (blob/decode data)]
(get-in data [:pages-index page-id :name])))
;; --- Mutation: Update Comment Thread Status ;; --- Mutation: Update Comment Thread Status
@ -164,14 +165,21 @@
[{:keys [profile-id thread-id content] :as params}] [{:keys [profile-id thread-id content] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true}) (let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
(comments/decode-row))] (comments/decode-row))
pname (retrieve-page-name conn thread)]
;; Standard Checks ;; Standard Checks
(when-not thread (when-not thread (ex/raise :type :not-found))
(ex/raise :type :not-found))
;; Permission Checks
(files/check-read-permissions! conn profile-id (:file-id thread)) (files/check-read-permissions! conn profile-id (:file-id thread))
;; Update the page-name cachedattribute on comment thread table.
(when (not= pname (:page-name thread))
(db/update! conn :comment-thread
{:page-name pname}
{:id thread-id}))
;; NOTE: is important that all timestamptz related fields are ;; NOTE: is important that all timestamptz related fields are
;; created or updated on the database level for avoid clock ;; created or updated on the database level for avoid clock
;; inconsistencies (some user sees something read that is not ;; inconsistencies (some user sees something read that is not
@ -216,15 +224,24 @@
(let [comment (db/get-by-id conn :comment id {:for-update true}) (let [comment (db/get-by-id conn :comment id {:for-update true})
_ (when-not comment (ex/raise :type :not-found)) _ (when-not comment (ex/raise :type :not-found))
thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true}) thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
_ (when-not thread (ex/raise :type :not-found))] _ (when-not thread (ex/raise :type :not-found))
pname (retrieve-page-name conn thread)]
(files/check-read-permissions! conn profile-id (:file-id thread)) (files/check-read-permissions! conn profile-id (:file-id thread))
;; Don't allow edit comments to not owners
(when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation
:code :not-allowed))
(db/update! conn :comment (db/update! conn :comment
{:content content {:content content
:modified-at (dt/now)} :modified-at (dt/now)}
{:id (:id comment)}) {:id (:id comment)})
(db/update! conn :comment-thread (db/update! conn :comment-thread
{:modified-at (dt/now)} {:modified-at (dt/now)
:page-name pname}
{:id (:id thread)}) {:id (:id thread)})
nil))) nil)))
@ -237,13 +254,14 @@
(sm/defmutation ::delete-comment-thread (sm/defmutation ::delete-comment-thread
[{:keys [profile-id id] :as params}] [{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})] (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id cthr) profile-id) (when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation (ex/raise :type :validation
:code :not-allowed)) :code :not-allowed))
(db/delete! conn :comment-thread {:id id}) (db/delete! conn :comment-thread {:id id})
nil))) nil)))
;; --- Mutation: Delete comment ;; --- Mutation: Delete comment
(s/def ::delete-comment (s/def ::delete-comment

9
backend/src/app/services/mutations/demo.clj
View File

@ -10,17 +10,14 @@
(ns app.services.mutations.demo (ns app.services.mutations.demo
"A demo specific mutations." "A demo specific mutations."
(:require (:require
[clojure.spec.alpha :as s] [app.common.uuid :as uuid]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]
[app.common.exceptions :as ex]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.mutations.profile :as profile] [app.services.mutations.profile :as profile]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.common.uuid :as uuid] [buddy.core.codecs :as bc]
[app.util.time :as tm])) [buddy.core.nonce :as bn]))
(sm/defmutation ::create-demo-profile (sm/defmutation ::create-demo-profile
[_] [_]

31
backend/src/app/services/mutations/files.clj
View File

@ -9,25 +9,22 @@
(ns app.services.mutations.files (ns app.services.mutations.files
(:require (:require
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[promesa.core :as p]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages-migrations :as pmg] [app.common.pages.migrations :as pmg]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.redis :as redis] [app.redis :as redis]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.queries.projects :as proj]
[app.services.queries.files :as files] [app.services.queries.files :as files]
[app.services.queries.projects :as proj]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.storage :as ust] [app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[app.util.time :as dt])) [clojure.spec.alpha :as s]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -62,7 +59,7 @@
:can-edit true})) :can-edit true}))
(defn create-file (defn create-file
[conn {:keys [id profile-id name project-id is-shared] [conn {:keys [id name project-id is-shared]
:or {is-shared false} :or {is-shared false}
:as params}] :as params}]
(let [id (or id (uuid/next)) (let [id (or id (uuid/next))
@ -162,11 +159,14 @@
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(link-file-to-library conn params))) (link-file-to-library conn params)))
(def sql:link-file-to-library
"insert into file_library_rel (file_id, library_file_id)
values (?, ?)
on conflict do nothing;")
(defn- link-file-to-library (defn- link-file-to-library
[conn {:keys [file-id library-id] :as params}] [conn {:keys [file-id library-id] :as params}]
(db/insert! conn :file-library-rel (db/exec-one! conn [sql:link-file-to-library file-id library-id]))
{:file-id file-id
:library-file-id library-id}))
;; --- Mutation: Unlink file from library ;; --- Mutation: Unlink file from library
@ -248,7 +248,8 @@
:add-media :mod-media :del-media :add-media :mod-media :del-media
:add-component :mod-component :del-component :add-component :mod-component :del-component
:add-typography :mod-typography :del-typography} (:type change)) :add-typography :mod-typography :del-typography} (:type change))
(and (= (:type change) :mod-obj) (and (#{:add-obj :mod-obj :del-obj
:reg-objects :mov-objects} (:type change))
(some? (:component-id change))))) (some? (:component-id change)))))
(declare update-file) (declare update-file)
@ -282,7 +283,7 @@
(assoc :changes (blob/encode changes) (assoc :changes (blob/encode changes)
:session-id sid)) :session-id sid))
chng (insert-change conn file) _ (insert-change conn file)
msg {:type :file-change msg {:type :file-change
:profile-id (:profile-id params) :profile-id (:profile-id params)
:file-id (:id file) :file-id (:id file)
@ -315,7 +316,7 @@
:data (:data file)} :data (:data file)}
{:id (:id file)}) {:id (:id file)})
(retrieve-lagged-changes conn chng params))) (retrieve-lagged-changes conn params)))
(defn- insert-change (defn- insert-change
[conn {:keys [revn data changes session-id] :as file}] [conn {:keys [revn data changes session-id] :as file}]
@ -339,7 +340,7 @@
order by s.created_at asc") order by s.created_at asc")
(defn- retrieve-lagged-changes (defn- retrieve-lagged-changes
[conn snapshot params] [conn params]
(->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)]) (->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
(mapv files/decode-row))) (mapv files/decode-row)))

71
backend/src/app/services/mutations/media.clj
View File

@ -9,21 +9,18 @@
(ns app.services.mutations.media (ns app.services.mutations.media
(:require (:require
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[app.common.media :as cm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.media :as media] [app.media :as media]
[app.media-storage :as mst]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.queries.teams :as teams] [app.services.queries.teams :as teams]
[app.tasks :as tasks]
[app.media-storage :as mst]
[app.util.storage :as ust] [app.util.storage :as ust]
[app.util.time :as dt])) [clojure.spec.alpha :as s]
[datoteka.core :as fs]))
(def thumbnail-options (def thumbnail-options
{:width 100 {:width 100
@ -38,7 +35,6 @@
(s/def ::team-id ::us/uuid) (s/def ::team-id ::us/uuid)
(s/def ::url ::us/url) (s/def ::url ::us/url)
;; --- Create Media object (Upload and create from url) ;; --- Create Media object (Upload and create from url)
(declare create-media-object) (declare create-media-object)
@ -51,20 +47,20 @@
(s/def ::add-media-object-from-url (s/def ::add-media-object-from-url
(s/keys :req-un [::profile-id ::file-id ::is-local ::url] (s/keys :req-un [::profile-id ::file-id ::is-local ::url]
:opt-un [::id])) :opt-un [::id ::name]))
(s/def ::upload-media-object (s/def ::upload-media-object
(s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content] (s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
:opt-un [::id])) :opt-un [::id]))
(sm/defmutation ::add-media-object-from-url (sm/defmutation ::add-media-object-from-url
[{:keys [profile-id file-id url] :as params}] [{:keys [profile-id file-id url name] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [file (select-file-for-update conn file-id)] (let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file)) (teams/check-edition-permissions! conn profile-id (:team-id file))
(let [content (media/download-media-object url) (let [content (media/download-media-object url)
params' (merge params {:content content params' (merge params {:content content
:name (:filename content)})] :name (or name (:filename content))})]
(create-media-object conn params'))))) (create-media-object conn params')))))
(sm/defmutation ::upload-media-object (sm/defmutation ::upload-media-object
@ -147,56 +143,3 @@
(-> thumb (-> thumb
(dissoc :data :input) (dissoc :data :input)
(assoc :path path)))) (assoc :path path))))
;; --- Mutation: Rename Media object
(declare select-media-object-for-update)
(s/def ::rename-media-object
(s/keys :req-un [::id ::profile-id ::name]))
(sm/defmutation ::rename-media-object
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(let [obj (select-media-object-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id obj))
(db/update! conn :media-object
{:name name}
{:id id}))))
(def ^:private sql:select-media-object-for-update
"select obj.*,
p.team_id as team_id
from media_object as obj
inner join file as f on (f.id = obj.file_id)
inner join project as p on (p.id = f.project_id)
where obj.id = ?
for update of obj")
(defn- select-media-object-for-update
[conn id]
(let [row (db/exec-one! conn [sql:select-media-object-for-update id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Delete Media object
(s/def ::delete-media-object
(s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-media-object
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(let [obj (select-media-object-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id obj))
;; Schedule object deletion
(tasks/submit! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :media-object}})
(db/update! conn :media-object
{:deleted-at (dt/now)}
{:id id})
nil)))

55
backend/src/app/services/mutations/profile.clj
View File

@ -10,27 +10,24 @@
(ns app.services.mutations.profile (ns app.services.mutations.profile
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.emails :as emails] [app.emails :as emails]
[app.media :as media]
[app.media-storage :as mst]
[app.http.session :as session] [app.http.session :as session]
[app.media :as media]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.mutations.projects :as projects] [app.services.mutations.projects :as projects]
[app.services.mutations.teams :as teams] [app.services.mutations.teams :as teams]
[app.services.mutations.verify-token :refer [process-token]]
[app.services.queries.profile :as profile] [app.services.queries.profile :as profile]
[app.services.tokens :as tokens] [app.services.tokens :as tokens]
[app.services.mutations.verify-token :refer [process-token]]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.storage :as ust]
[app.util.time :as dt] [app.util.time :as dt]
[buddy.hashers :as hashers] [buddy.hashers :as hashers]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str])) [cuerdas.core :as str]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -142,11 +139,20 @@
(defn- derive-password (defn- derive-password
[password] [password]
(hashers/derive password {:alg :bcrypt+sha512})) (hashers/derive password
{:alg :argon2id
:memory 16384
:iterations 20
:parallelism 2}))
(defn- verify-password (defn- verify-password
[attempt password] [attempt password]
(hashers/verify attempt password)) (try
(hashers/verify attempt password)
(catch Exception e
(log/warnf e "Error on verify password (only informative, nothing affected to user).")
{:update false
:valid false})))
(defn- create-profile (defn- create-profile
"Create the profile entry on the database with limited input "Create the profile entry on the database with limited input
@ -274,7 +280,7 @@
(defn- validate-password! (defn- validate-password!
[conn {:keys [profile-id old-password] :as params}] [conn {:keys [profile-id old-password] :as params}]
(let [profile (profile/retrieve-profile-data conn profile-id)] (let [profile (db/get-by-id conn :profile profile-id)]
(when-not (:valid (verify-password old-password (:password profile))) (when-not (:valid (verify-password old-password (:password profile)))
(ex/raise :type :validation (ex/raise :type :validation
:code :old-password-not-match)))) :code :old-password-not-match))))
@ -304,7 +310,7 @@
[{:keys [profile-id file] :as params}] [{:keys [profile-id file] :as params}]
(media/validate-media-type (:content-type file)) (media/validate-media-type (:content-type file))
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [profile (profile/retrieve-profile conn profile-id) (let [profile (db/get-by-id conn :profile profile-id)
_ (media/run {:cmd :info :input {:path (:tempfile file) _ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}}) :mtype (:content-type file)}})
photo (teams/upload-photo conn params)] photo (teams/upload-photo conn params)]
@ -361,7 +367,7 @@
(sm/defmutation ::request-profile-recovery (sm/defmutation ::request-profile-recovery
[{:keys [email] :as params}] [{:keys [email] :as params}]
(letfn [(create-recovery-token [conn {:keys [id] :as profile}] (letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (let [token (tokens/generate
{:iss :password-recovery {:iss :password-recovery
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
@ -377,7 +383,7 @@
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(some->> email (some->> email
(profile/retrieve-profile-data-by-email conn) (profile/retrieve-profile-data-by-email conn)
(create-recovery-token conn) (create-recovery-token)
(send-email-notification conn)) (send-email-notification conn))
nil))) nil)))
@ -390,7 +396,7 @@
(sm/defmutation ::recover-profile (sm/defmutation ::recover-profile
[{:keys [token password]}] [{:keys [token password]}]
(letfn [(validate-token [conn token] (letfn [(validate-token [token]
(let [tdata (tokens/verify token {:iss :password-recovery})] (let [tdata (tokens/verify token {:iss :password-recovery})]
(:profile-id tdata))) (:profile-id tdata)))
@ -399,10 +405,31 @@
(db/update! conn :profile {:password pwd} {:id profile-id})))] (db/update! conn :profile {:password pwd} {:id profile-id})))]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(->> (validate-token conn token) (->> (validate-token token)
(update-password conn)) (update-password conn))
nil))) nil)))
;; --- Mutation: Update Profile Props
(s/def ::props map?)
(s/def ::update-profile-props
(s/keys :req-un [::profile-id ::props]))
(sm/defmutation ::update-profile-props
[{:keys [profile-id props]}]
(db/with-atomic [conn db/pool]
(let [profile (profile/retrieve-profile-data conn profile-id)
props (reduce-kv (fn [props k v]
(if (nil? v)
(dissoc props k)
(assoc props k v)))
(:props profile)
props)]
(db/update! conn :profile
{:props (db/tjson props)}
{:id profile-id})
nil)))
;; --- Mutation: Delete Profile ;; --- Mutation: Delete Profile

19
backend/src/app/services/mutations/projects.clj
View File

@ -5,12 +5,10 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.projects (ns app.services.mutations.projects
(:require (:require
[clojure.spec.alpha :as s]
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
@ -18,7 +16,7 @@
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.queries.projects :as proj] [app.services.queries.projects :as proj]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob])) [clojure.spec.alpha :as s]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -48,7 +46,7 @@
(assoc proj :is-pinned true)))) (assoc proj :is-pinned true))))
(defn create-project (defn create-project
[conn {:keys [id profile-id team-id name default?] :as params}] [conn {:keys [id team-id name default?] :as params}]
(let [id (or id (uuid/next)) (let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)] default? (if (boolean? default?) default? false)]
(db/insert! conn :project (db/insert! conn :project
@ -107,11 +105,10 @@
(sm/defmutation ::rename-project (sm/defmutation ::rename-project
[{:keys [id profile-id name] :as params}] [{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [project (db/get-by-id conn :project id {:for-update true})] (proj/check-edition-permissions! conn profile-id id)
(proj/check-edition-permissions! conn profile-id id) (db/update! conn :project
(db/update! conn :project {:name name}
{:name name} {:id id})))
{:id id}))))
;; --- Mutation: Delete Project ;; --- Mutation: Delete Project
@ -139,6 +136,6 @@
returning id") returning id")
(defn mark-project-deleted (defn mark-project-deleted
[conn {:keys [id profile-id] :as params}] [conn {:keys [id] :as params}]
(db/exec! conn [sql:mark-project-deleted id]) (db/exec! conn [sql:mark-project-deleted id])
nil) nil)

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

@ -20,9 +20,9 @@
[app.media-storage :as mst] [app.media-storage :as mst]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.mutations.projects :as projects] [app.services.mutations.projects :as projects]
[app.services.queries.profile :as profile]
[app.services.queries.teams :as teams] [app.services.queries.teams :as teams]
[app.services.tokens :as tokens] [app.services.tokens :as tokens]
[app.services.queries.profile :as profile]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.storage :as ust] [app.util.storage :as ust]
[app.util.time :as dt] [app.util.time :as dt]
@ -58,7 +58,7 @@
team))) team)))
(defn create-team (defn create-team
[conn {:keys [id profile-id name default?] :as params}] [conn {:keys [id name default?] :as params}]
(let [id (or id (uuid/next)) (let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)] default? (if (boolean? default?) default? false)]
(db/insert! conn :team (db/insert! conn :team
@ -268,7 +268,7 @@
(assoc team :photo (str photo))))) (assoc team :photo (str photo)))))
(defn upload-photo (defn upload-photo
[conn {:keys [file profile-id]}] [_conn {:keys [file]}]
(let [prefix (-> (bn/random-bytes 8) (let [prefix (-> (bn/random-bytes 8)
(bc/bytes->b64u) (bc/bytes->b64u)
(bc/bytes->str)) (bc/bytes->str))

39
backend/src/app/services/mutations/verify_token.clj
View File

@ -10,28 +10,16 @@
(ns app.services.mutations.verify-token (ns app.services.mutations.verify-token
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.emails :as emails]
[app.http.session :as session] [app.http.session :as session]
[app.media :as media]
[app.media-storage :as mst]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.mutations.teams :as teams] [app.services.mutations.teams :as teams]
[app.services.queries.profile :as profile] [app.services.queries.profile :as profile]
[app.services.tokens :as tokens] [app.services.tokens :as tokens]
[app.tasks :as tasks] [clojure.spec.alpha :as s]))
[app.util.blob :as blob]
[app.util.storage :as ust]
[app.util.time :as dt]
[buddy.hashers :as hashers]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(defmulti process-token (fn [conn params claims] (:iss claims))) (defmulti process-token (fn [_ _ claims] (:iss claims)))
(s/def ::verify-token (s/def ::verify-token
(s/keys :req-un [::token] (s/keys :req-un [::token]
@ -44,18 +32,17 @@
(process-token conn params claims)))) (process-token conn params claims))))
(defmethod process-token :change-email (defmethod process-token :change-email
[conn params {:keys [profile-id email] :as claims}] [conn _params {:keys [profile-id email] :as claims}]
(let [profile (db/get-by-id conn :profile profile-id {:for-update true})] (when (profile/retrieve-profile-data-by-email conn email)
(when (profile/retrieve-profile-data-by-email conn email) (ex/raise :type :validation
(ex/raise :type :validation :code :email-already-exists))
:code :email-already-exists)) (db/update! conn :profile
(db/update! conn :profile {:email email}
{:email email} {:id profile-id})
{:id profile-id}) claims)
claims))
(defmethod process-token :verify-email (defmethod process-token :verify-email
[conn params {:keys [profile-id] :as claims}] [conn _params {:keys [profile-id] :as claims}]
(let [profile (db/get-by-id conn :profile profile-id {:for-update true})] (let [profile (db/get-by-id conn :profile profile-id {:for-update true})]
(when (:is-active profile) (when (:is-active profile)
(ex/raise :type :validation (ex/raise :type :validation
@ -71,7 +58,7 @@
claims)) claims))
(defmethod process-token :auth (defmethod process-token :auth
[conn params {:keys [profile-id] :as claims}] [conn _params {:keys [profile-id] :as claims}]
(let [profile (profile/retrieve-profile conn profile-id)] (let [profile (profile/retrieve-profile conn profile-id)]
(assoc claims :profile profile))) (assoc claims :profile profile)))
@ -137,7 +124,7 @@
;; --- Default ;; --- Default
(defmethod process-token :default (defmethod process-token :default
[conn params claims] [_ _ _]
(ex/raise :type :validation (ex/raise :type :validation
:code :invalid-token)) :code :invalid-token))

3
backend/src/app/services/mutations/viewer.clj
View File

@ -9,10 +9,7 @@
(ns app.services.mutations.viewer (ns app.services.mutations.viewer
(:require (:require
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.services.mutations :as sm]
[app.services.queries.files :as files] [app.services.queries.files :as files]

27
backend/src/app/services/notifications.clj
View File

@ -10,17 +10,13 @@
(ns app.services.notifications (ns app.services.notifications
"A websocket based notifications mechanism." "A websocket based notifications mechanism."
(:require (:require
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.redis :as redis] [app.redis :as redis]
[app.util.async :as aa] [app.util.async :as aa]
[app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[promesa.core :as p]
[ring.adapter.jetty9 :as jetty])) [ring.adapter.jetty9 :as jetty]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -40,7 +36,7 @@
:help "A total number of messages handled by the notifications service."})) :help "A total number of messages handled by the notifications service."}))
(defn websocket (defn websocket
[{:keys [file-id team-id profile-id] :as params}] [{:keys [file-id team-id] :as params}]
(let [in (a/chan 32) (let [in (a/chan 32)
out (a/chan 32)] out (a/chan 32)]
{:on-connect {:on-connect
@ -62,18 +58,18 @@
(a/close! sub)))) (a/close! sub))))
:on-error :on-error
(fn [conn e] (fn [_conn _e]
(a/close! out) (a/close! out)
(a/close! in)) (a/close! in))
:on-close :on-close
(fn [conn status-code reason] (fn [_conn _status _reason]
(metrics-active-connections :dec) (metrics-active-connections :dec)
(a/close! out) (a/close! out)
(a/close! in)) (a/close! in))
:on-text :on-text
(fn [ws message] (fn [_ws message]
(metrics-message-counter :inc) (metrics-message-counter :inc)
(let [message (t/decode-str message)] (let [message (t/decode-str message)]
(a/>!! in message))) (a/>!! in message)))
@ -165,8 +161,7 @@
(defn- update-presence (defn- update-presence
[file-id session-id profile-id] [file-id session-id profile-id]
(aa/thread-try (aa/thread-try
(let [now (dt/now) (let [sql [sql:update-presence file-id session-id profile-id]]
sql [sql:update-presence file-id session-id profile-id]]
(db/exec-one! db/pool sql)))) (db/exec-one! db/pool sql))))
(defn- delete-presence (defn- delete-presence
@ -177,13 +172,13 @@
:session-id session-id}))) :session-id session-id})))
(defmulti handle-message (defmulti handle-message
(fn [ws message] (:type message))) (fn [_ message] (:type message)))
;; TODO: check permissions for join a file-id channel (probably using ;; TODO: check permissions for join a file-id channel (probably using
;; single use token for avoid explicit database query). ;; single use token for avoid explicit database query).
(defmethod handle-message :connect (defmethod handle-message :connect
[{:keys [file-id profile-id session-id output] :as ws} message] [{:keys [file-id profile-id session-id] :as ws} _message]
(log/debugf "profile '%s' is connected to file '%s'" profile-id file-id) (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
(aa/go-try (aa/go-try
(aa/<? (update-presence file-id session-id profile-id)) (aa/<? (update-presence file-id session-id profile-id))
@ -191,7 +186,7 @@
(aa/<? (publish file-id {:type :presence :sessions members}))))) (aa/<? (publish file-id {:type :presence :sessions members})))))
(defmethod handle-message :disconnect (defmethod handle-message :disconnect
[{:keys [profile-id file-id session-id] :as ws} message] [{:keys [profile-id file-id session-id] :as ws} _message]
(log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id) (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
(aa/go-try (aa/go-try
(aa/<? (delete-presence file-id session-id profile-id)) (aa/<? (delete-presence file-id session-id profile-id))
@ -199,7 +194,7 @@
(aa/<? (publish file-id {:type :presence :sessions members}))))) (aa/<? (publish file-id {:type :presence :sessions members})))))
(defmethod handle-message :keepalive (defmethod handle-message :keepalive
[{:keys [profile-id file-id session-id] :as ws} message] [{:keys [profile-id file-id session-id] :as ws} _message]
(update-presence file-id session-id profile-id)) (update-presence file-id session-id profile-id))
(defmethod handle-message :pointer-update (defmethod handle-message :pointer-update
@ -210,6 +205,6 @@
(publish file-id message))) (publish file-id message)))
(defmethod handle-message :default (defmethod handle-message :default
[ws message] [_ws message]
(a/go (a/go
(log/warnf "received unexpected message: " message))) (log/warnf "received unexpected message: %s" message)))

68
backend/src/app/services/queries/comments.clj
View File

@ -9,18 +9,12 @@
(ns app.services.queries.comments (ns app.services.queries.comments
(:require (:require
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.files :as files] [app.services.queries.files :as files]
[app.util.time :as dt] [app.services.queries.teams :as teams]
[app.util.transit :as t] [clojure.spec.alpha :as s]))
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[promesa.core :as p]))
(defn decode-row (defn decode-row
[{:keys [participants position] :as row}] [{:keys [participants position] :as row}]
@ -32,9 +26,13 @@
(declare retrieve-comment-threads) (declare retrieve-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::comment-threads (s/def ::comment-threads
(s/keys :req-un [::profile-id ::file-id])) (s/and (s/keys :req-un [::profile-id]
:opt-un [::file-id ::team-id])
#(or (:file-id %) (:team-id %))))
(sq/defquery ::comment-threads (sq/defquery ::comment-threads
[{:keys [profile-id file-id] :as params}] [{:keys [profile-id file-id] :as params}]
@ -45,6 +43,8 @@
(def sql:comment-threads (def sql:comment-threads
"select distinct on (ct.id) "select distinct on (ct.id)
ct.*, ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content, first_value(c.content) over w as content,
(select count(1) (select count(1)
from comment as c from comment as c
@ -55,6 +55,7 @@
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id) inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
left join comment_thread_status as cts left join comment_thread_status as cts
on (cts.thread_id = ct.id and on (cts.thread_id = ct.id and
cts.profile_id = ?) cts.profile_id = ?)
@ -63,9 +64,58 @@
(defn- retrieve-comment-threads (defn- retrieve-comment-threads
[conn {:keys [profile-id file-id]}] [conn {:keys [profile-id file-id]}]
(files/check-read-permissions! conn profile-id file-id)
(->> (db/exec! conn [sql:comment-threads profile-id file-id]) (->> (db/exec! conn [sql:comment-threads profile-id file-id])
(into [] (map decode-row)))) (into [] (map decode-row))))
;; --- Query: Unread Comment Threads
(declare retrieve-unread-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::unread-comment-threads
(s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::unread-comment-threads
[{:keys [profile-id team-id] :as params}]
(with-open [conn (db/open)]
(teams/check-read-permissions! conn profile-id team-id)
(retrieve-unread-comment-threads conn params)))
(def sql:comment-threads-by-team
"select distinct on (ct.id)
ct.*,
f.name as file_name,
f.project_id as project_id,
first_value(c.content) over w as content,
(select count(1)
from comment as c
where c.thread_id = ct.id) as count_comments,
(select count(1)
from comment as c
where c.thread_id = ct.id
and c.created_at >= coalesce(cts.modified_at, ct.created_at)) as count_unread_comments
from comment_thread as ct
inner join comment as c on (c.thread_id = ct.id)
inner join file as f on (f.id = ct.file_id)
inner join project as p on (p.id = f.project_id)
left join comment_thread_status as cts
on (cts.thread_id = ct.id and
cts.profile_id = ?)
where p.team_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(def sql:unread-comment-threads-by-team
(str "with threads as (" sql:comment-threads-by-team ")"
"select * from threads where count_unread_comments > 0"))
(defn retrieve-unread-comment-threads
[conn {:keys [profile-id team-id]}]
(->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
(into [] (map decode-row))))
;; --- Query: Single Comment Thread ;; --- Query: Single Comment Thread
(s/def ::id ::us/uuid) (s/def ::id ::us/uuid)

49
backend/src/app/services/queries/files.clj
View File

@ -5,20 +5,18 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.files (ns app.services.queries.files
(:require (:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[app.common.pages-migrations :as pmg]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.media :as media]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.projects :as projects] [app.services.queries.projects :as projects]
[app.util.blob :as blob])) [app.util.blob :as blob]
[clojure.spec.alpha :as s]))
(declare decode-row) (declare decode-row)
(declare decode-row-xf) (declare decode-row-xf)
@ -185,48 +183,11 @@
(let [file (retrieve-file conn file-id)] (let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id])))) (get-in file [:data :pages-index id]))))
;; --- Query: File users
(def ^:private sql:file-users
"select pf.id, pf.fullname, pf.photo
from profile as pf
inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
where fpr.file_id = ?
union
select pf.id, pf.fullname, pf.photo
from profile as pf
inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
inner join project as p on (tpr.team_id = p.team_id)
inner join file as f on (p.id = f.project_id)
where f.id = ?")
(defn retrieve-file-users
[conn id]
(->> (db/exec! conn [sql:file-users id id])
(mapv #(media/resolve-media-uris % [:photo :photo-uri]))))
(s/def ::file-users
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::file-users
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id id)
(retrieve-file-users conn id)))
;; --- Query: Shared Library Files ;; --- Query: Shared Library Files
;; TODO: remove the counts, because they are no longer needed.
(def ^:private sql:shared-files (def ^:private sql:shared-files
"select f.*, "select f.*
(select count(*) from color as c
where c.file_id = f.id
and c.deleted_at is null) as colors_count,
(select count(*) from media_object as m
where m.file_id = f.id
and m.is_local = false
and m.deleted_at is null) as graphics_count
from file as f from file as f
inner join project as p on (p.id = f.project_id) inner join project as p on (p.id = f.project_id)
where f.is_shared = true where f.is_shared = true

109
backend/src/app/services/queries/media.clj
View File

@ -1,109 +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) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns app.services.queries.media
(:require
[clojure.spec.alpha :as s]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.media :as media]
[app.services.queries :as sq]
[app.services.queries.teams :as teams]))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::file-id ::us/uuid)
;; --- Query: Media objects (by file)
(declare retrieve-media-objects)
(declare retrieve-file)
(s/def ::is-local ::us/boolean)
(s/def ::media-objects
(s/keys :req-un [::profile-id ::file-id ::is-local]))
;; TODO: check if we can resolve url with transducer for reduce
;; garbage generation for each request
(sq/defquery ::media-objects
[{:keys [profile-id file-id is-local] :as params}]
(db/with-atomic [conn db/pool]
(let [file (retrieve-file conn file-id)]
(teams/check-read-permissions! conn profile-id (:team-id file))
(->> (retrieve-media-objects conn file-id is-local)
(mapv #(media/resolve-urls % :path :uri))
(mapv #(media/resolve-urls % :thumb-path :thumb-uri))))))
(def ^:private sql:media-objects
"select obj.*,
thumb.path as thumb_path
from media_object as obj
inner join media_thumbnail as thumb on obj.id = thumb.media_object_id
where obj.deleted_at is null
and obj.file_id = ?
and obj.is_local = ?
order by obj.created_at desc")
(defn retrieve-media-objects
[conn file-id is-local]
(db/exec! conn [sql:media-objects file-id is-local]))
(def ^:private sql:retrieve-file
"select file.*,
project.team_id as team_id
from file
inner join project on (project.id = file.project_id)
where file.id = ?")
(defn- retrieve-file
[conn id]
(let [row (db/exec-one! conn [sql:retrieve-file id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Query: Media object (by ID)
(declare retrieve-media-object)
(s/def ::id ::us/uuid)
(s/def ::media-object
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::media-object
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(let [media-object (retrieve-media-object conn id)]
(teams/check-read-permissions! conn profile-id (:team-id media-object))
(-> media-object
(media/resolve-urls :path :uri)))))
(def ^:private sql:media-object
"select obj.*,
p.team_id as team_id
from media_object as obj
inner join file as f on (f.id = obj.file_id)
inner join project as p on (p.id = f.project_id)
where obj.deleted_at is null
and obj.id = ?
order by created_at desc")
(defn retrieve-media-object
[conn id]
(let [row (db/exec-one! conn [sql:media-object id])]
(when-not row
(ex/raise :type :not-found))
row))

23
backend/src/app/services/queries/profile.clj
View File

@ -9,15 +9,13 @@
(ns app.services.queries.profile (ns app.services.queries.profile
(:require (:require
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db]
[app.media :as media]
[app.services.queries :as sq]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.util.blob :as blob])) [app.db :as db]
[app.services.queries :as sq]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -25,7 +23,6 @@
(s/def ::email ::us/email) (s/def ::email ::us/email)
(s/def ::fullname ::us/string) (s/def ::fullname ::us/string)
(s/def ::metadata any?)
(s/def ::old-password ::us/string) (s/def ::old-password ::us/string)
(s/def ::password ::us/string) (s/def ::password ::us/string)
(s/def ::path ::us/string) (s/def ::path ::us/string)
@ -75,14 +72,19 @@
{:default-team-id (:id team) {:default-team-id (:id team)
:default-project-id (:id project)})) :default-project-id (:id project)}))
(defn decode-profile-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props) (assoc :props (db/decode-transit-pgobject props))))
(defn retrieve-profile-data (defn retrieve-profile-data
[conn id] [conn id]
(db/get-by-id conn :profile id)) (-> (db/get-by-id conn :profile id)
(decode-profile-row)))
(defn retrieve-profile (defn retrieve-profile
[conn id] [conn id]
(let [profile (some-> (retrieve-profile-data conn id) (let [profile (some-> (retrieve-profile-data conn id)
(media/resolve-urls :photo :photo-uri)
(strip-private-attrs) (strip-private-attrs)
(merge (retrieve-additional-data conn id)))] (merge (retrieve-additional-data conn id)))]
(when (nil? profile) (when (nil? profile)
@ -100,7 +102,8 @@
(defn retrieve-profile-data-by-email (defn retrieve-profile-data-by-email
[conn email] [conn email]
(let [email (str/lower email)] (let [email (str/lower email)]
(db/exec-one! conn [sql:profile-by-email email]))) (-> (db/exec-one! conn [sql:profile-by-email email])
(decode-profile-row))))
;; --- Attrs Helpers ;; --- Attrs Helpers

6
backend/src/app/services/queries/projects.clj
View File

@ -9,12 +9,12 @@
(ns app.services.queries.projects (ns app.services.queries.projects
(:require (:require
[clojure.spec.alpha :as s]
[app.common.spec :as us]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.teams :as teams])) [app.services.queries.teams :as teams]
[clojure.spec.alpha :as s]))
;; --- Check Project Permissions ;; --- Check Project Permissions

10
backend/src/app/services/queries/recent_files.clj
View File

@ -5,18 +5,16 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.recent-files (ns app.services.queries.recent-files
(:require (:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[app.db :as db]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.files :refer [decode-row-xf]]
[app.services.queries.teams :as teams] [app.services.queries.teams :as teams]
[app.services.queries.projects :as projects :refer [retrieve-projects]] [clojure.spec.alpha :as s]))
[app.services.queries.files :refer [decode-row-xf]]))
(def sql:recent-files (def sql:recent-files
"with recent_files as ( "with recent_files as (

88
backend/src/app/services/queries/teams.clj
View File

@ -5,18 +5,16 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.teams (ns app.services.queries.teams
(:require (:require
[clojure.spec.alpha :as s]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.profile :as profile] [app.services.queries.profile :as profile]
[app.util.blob :as blob])) [clojure.spec.alpha :as s]))
;; --- Team Edition Permissions ;; --- Team Edition Permissions
@ -130,3 +128,85 @@
(defn retrieve-team-members (defn retrieve-team-members
[conn team-id] [conn team-id]
(db/exec! conn [sql:team-members team-id])) (db/exec! conn [sql:team-members team-id]))
;; --- Query: Team Users
(declare retrieve-users)
(declare retrieve-team-for-file)
(s/def ::file-id ::us/uuid)
(s/def ::team-users
(s/and (s/keys :req-un [::profile-id]
:opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %))))
(sq/defquery ::team-users
[{:keys [profile-id team-id file-id]}]
(with-open [conn (db/open)]
(if team-id
(do
(check-edition-permissions! conn profile-id team-id)
(retrieve-users conn team-id))
(let [{team-id :id} (retrieve-team-for-file conn file-id)]
(check-edition-permissions! conn profile-id team-id)
(retrieve-users conn team-id)))))
;; This is a similar query to team members but can contain more data
;; because some user can be explicitly added to project or file (not
;; implemented in UI)
(def sql:team-users
"select pf.id, pf.fullname, pf.photo
from profile as pf
inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
where tpr.team_id = ?
union
select pf.id, pf.fullname, pf.photo
from profile as pf
inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
inner join project as p on (ppr.project_id = p.id)
where p.team_id = ?
union
select pf.id, pf.fullname, pf.photo
from profile as pf
inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
inner join file as f on (fpr.file_id = f.id)
inner join project as p on (f.project_id = p.id)
where p.team_id = ?")
(def sql:team-by-file
"select p.team_id as id
from project as p
join file as f on (p.id = f.project_id)
where f.id = ?")
(defn retrieve-users
[conn team-id]
(db/exec! conn [sql:team-users team-id team-id team-id]))
(defn retrieve-team-for-file
[conn file-id]
(->> [sql:team-by-file file-id]
(db/exec-one! conn)))
;; --- Query: Team Stats
(declare retrieve-team-stats)
(s/def ::team-stats
(s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::team-stats
[{:keys [profile-id team-id]}]
(with-open [conn (db/open)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id)))
(def sql:team-stats
"select (select count(*) from project where team_id = ?) as projects,
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
(defn retrieve-team-stats
[conn team-id]
(db/exec-one! conn [sql:team-stats team-id team-id]))

42
backend/src/app/services/queries/viewer.clj
View File

@ -14,6 +14,7 @@
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.queries.files :as files] [app.services.queries.files :as files]
[app.services.queries.teams :as teams]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Query: Viewer Bundle (by Page ID) ;; --- Query: Viewer Bundle (by Page ID)
@ -23,7 +24,7 @@
(def ^:private (def ^:private
sql:project sql:project
"select p.id, p.name "select p.id, p.name, p.team_id
from project as p from project as p
where p.id = ? where p.id = ?
and p.deleted_at is null") and p.deleted_at is null")
@ -35,40 +36,43 @@
(s/def ::id ::us/uuid) (s/def ::id ::us/uuid)
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::page-id ::us/uuid) (s/def ::page-id ::us/uuid)
(s/def ::share-token ::us/string) (s/def ::token ::us/string)
(s/def ::viewer-bundle (s/def ::viewer-bundle
(s/keys :req-un [::file-id ::page-id] (s/keys :req-un [::file-id ::page-id]
:opt-un [::profile-id ::share-token])) :opt-un [::profile-id ::token]))
(sq/defquery ::viewer-bundle (sq/defquery ::viewer-bundle
[{:keys [profile-id file-id page-id share-token] :as params}] [{:keys [profile-id file-id page-id token] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [file (files/retrieve-file conn file-id) (let [file (files/retrieve-file conn file-id)
project (retrieve-project conn (:project-id file)) project (retrieve-project conn (:project-id file))
page (get-in file [:data :pages-index page-id]) page (get-in file [:data :pages-index page-id])
file (merge (dissoc file :data)
(select-keys (:data file) [:colors :media :typographies]))
libs (files/retrieve-file-libraries conn false file-id)
users (teams/retrieve-users conn (:team-id project))
file-library (select-keys (:data file) [:colors :media :typographies]) bundle {:file file
bundle {:file (-> (dissoc file :data) :page page
(merge file-library)) :users users
:page (get-in file [:data :pages-index page-id]) :project project
:project project} :libraries libs}]
]
(if (string? share-token) (if (string? token)
(do (do
(check-shared-token! conn file-id page-id share-token) (check-shared-token! conn file-id page-id token)
(assoc bundle :share-token share-token)) (assoc bundle :token token))
(let [token (retrieve-shared-token conn file-id page-id)] (let [stoken (retrieve-shared-token conn file-id page-id)]
(files/check-edition-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
(assoc bundle :share-token token)))))) (assoc bundle :token (:token stoken)))))))
(defn check-shared-token! (defn check-shared-token!
[conn file-id page-id token] [conn file-id page-id token]
(let [sql "select exists(select 1 from file_share_token where file_id=? and page_id=? and token=?) as exists"] (let [sql "select exists(select 1 from file_share_token where file_id=? and page_id=? and token=?) as exists"]
(when-not (:exists (db/exec-one! conn [sql file-id page-id token])) (when-not (:exists (db/exec-one! conn [sql file-id page-id token]))
(ex/raise :type :validation (ex/raise :type :authorization
:code :not-authorized)))) :code :unauthorized-token))))
(defn retrieve-shared-token (defn retrieve-shared-token
[conn file-id page-id] [conn file-id page-id]

5
backend/src/app/services/tokens.clj
View File

@ -10,16 +10,11 @@
(ns app.services.tokens (ns app.services.tokens
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db]
[app.util.time :as dt] [app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[buddy.core.codecs :as bc]
[buddy.core.kdf :as bk] [buddy.core.kdf :as bk]
[buddy.core.nonce :as bn]
[buddy.sign.jwe :as jwe] [buddy.sign.jwe :as jwe]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [clojure.tools.logging :as log]))
(defn- derive-tokens-secret (defn- derive-tokens-secret

6
backend/src/app/srepl/main.clj Normal file
View File

@ -0,0 +1,6 @@
(ns app.srepl.main
"A main namespace for server repl."
#_:clj-kondo/ignore
(:require
[clojure.pprint :refer [pprint]]
[app.db :as db]))

38
backend/src/app/srepl/server.clj Normal file
View File

@ -0,0 +1,38 @@
;; 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.srepl.server
"Server Repl."
(:require
[app.srepl.main]
[clojure.core.server :as ccs]
[clojure.main :as cm]
[mount.core :as mount :refer [defstate]]))
(defn- repl-init
[]
(ccs/repl-init)
(in-ns 'app.srepl.main))
(defn repl
[]
(cm/repl
:init repl-init
:read ccs/repl-read))
(defstate server
:start (ccs/start-server
{:address "127.0.0.1"
:port 6062
:name "main"
:accept 'app.srepl.server/repl})
:stop (ccs/stop-server "main"))

1
backend/src/app/tasks.clj
View File

@ -11,7 +11,6 @@
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]

20
backend/src/app/tasks/delete_object.clj
View File

@ -10,13 +10,11 @@
(ns app.tasks.delete-object (ns app.tasks.delete-object
"Generic task for permanent deletion of objects." "Generic task for permanent deletion of objects."
(:require (:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.storage :as ust])) [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
(s/def ::type keyword?) (s/def ::type keyword?)
(s/def ::id ::us/uuid) (s/def ::id ::us/uuid)
@ -24,10 +22,10 @@
(s/def ::props (s/def ::props
(s/keys :req-un [::id ::type])) (s/keys :req-un [::id ::type]))
(defmulti handle-deletion (fn [conn props] (:type props))) (defmulti handle-deletion (fn [_ props] (:type props)))
(defmethod handle-deletion :default (defmethod handle-deletion :default
[conn {:keys [type id] :as props}] [_conn {:keys [type]}]
(log/warn "no handler found for" type)) (log/warn "no handler found for" type))
(defn handler (defn handler
@ -55,13 +53,3 @@
[conn {:keys [id] :as props}] [conn {:keys [id] :as props}]
(let [sql "delete from media_object where id=? and deleted_at is not null"] (let [sql "delete from media_object where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id]))) (db/exec-one! conn [sql id])))
(defmethod handle-deletion :color
[conn {:keys [id] :as props}]
(let [sql "delete from color where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))
(defmethod handle-deletion :page
[conn {:keys [id] :as props}]
(let [sql "delete from page where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))

11
backend/src/app/tasks/delete_profile.clj
View File

@ -10,13 +10,11 @@
(ns app.tasks.delete-profile (ns app.tasks.delete-profile
"Task for permanent deletion of profiles." "Task for permanent deletion of profiles."
(:require (:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.storage :as ust])) [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
(declare delete-profile-data) (declare delete-profile-data)
(declare delete-teams) (declare delete-teams)
@ -51,11 +49,6 @@
(delete-files conn profile-id) (delete-files conn profile-id)
(delete-profile conn profile-id)) (delete-profile conn profile-id))
(def ^:private sql:select-profile
"select id, is_demo, deleted_at
from profile
where id=? for update")
(def ^:private sql:remove-owned-teams (def ^:private sql:remove-owned-teams
"with teams as ( "with teams as (
select distinct select distinct

5
backend/src/app/tasks/maintenance.clj
View File

@ -10,8 +10,6 @@
(ns app.tasks.maintenance (ns app.tasks.maintenance
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.common.exceptions :as ex]
[app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]
@ -22,6 +20,9 @@
;; Task: Delete Executed Tasks ;; Task: Delete Executed Tasks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This tasks perform a cleanup of already executed tasks from the
;; database.
(s/def ::max-age ::dt/duration) (s/def ::max-age ::dt/duration)
(s/def ::delete-completed-tasks (s/def ::delete-completed-tasks
(s/keys :req-un [::max-age])) (s/keys :req-un [::max-age]))

8
backend/src/app/tasks/remove_media.clj
View File

@ -22,6 +22,10 @@
;; Task: Remove Media ;; Task: Remove Media
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task responsible of explicit action of removing a media from file
;; system. Mainly used for profile photo change; when we really know
;; that the previous photo becomes unused.
(s/def ::path ::us/not-empty-string) (s/def ::path ::us/not-empty-string)
(s/def ::props (s/def ::props
(s/keys :req-un [::path])) (s/keys :req-un [::path]))
@ -69,10 +73,10 @@
returning *") returning *")
(defn trim-media-storage (defn trim-media-storage
[{:keys [props] :as task}] [_task]
(letfn [(decode-row [{:keys [data] :as row}] (letfn [(decode-row [{:keys [data] :as row}]
(cond-> row (cond-> row
(db/pgobject? data) (assoc :data (db/decode-pgobject data)))) (db/pgobject? data) (assoc :data (db/decode-json-pgobject data))))
(retrieve-items [conn] (retrieve-items [conn]
(->> (db/exec! conn [sql:retrieve-peding-to-delete 10]) (->> (db/exec! conn [sql:retrieve-peding-to-delete 10])
(map decode-row) (map decode-row)

8
backend/src/app/tasks/sendmail.clj
View File

@ -9,12 +9,10 @@
(ns app.tasks.sendmail (ns app.tasks.sendmail
(:require (:require
[clojure.tools.logging :as log]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.util.emails :as emails]
[app.config :as cfg] [app.config :as cfg]
[app.metrics :as mtx])) [app.metrics :as mtx]
[app.util.emails :as emails]
[clojure.tools.logging :as log]))
(defn- send-console! (defn- send-console!
[config email] [config email]

68
backend/src/app/tasks/trim_file.clj
View File

@ -9,15 +9,13 @@
(ns app.tasks.trim-file (ns app.tasks.trim-file
(:require (:require
[clojure.spec.alpha :as s] [app.common.pages.migrations :as pmg]
[clojure.tools.logging :as log]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.time :as dt])) [app.util.time :as dt]
[clojure.tools.logging :as log]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task: Trim File ;; Task: Trim File
@ -27,54 +25,62 @@
;; associated with file but not used by any page. ;; associated with file but not used by any page.
(defn decode-row (defn decode-row
[{:keys [data metadata changes] :as row}] [{:keys [data] :as row}]
(cond-> row (cond-> row
(bytes? data) (assoc :data (blob/decode data)))) (bytes? data) (assoc :data (blob/decode data))))
(def sql:retrieve-files-to-trim (def sql:retrieve-files-to-trim
"select id from file as f "select f.id, f.data
from file as f
where f.has_media_trimmed is false where f.has_media_trimmed is false
and f.modified_at < now() - ?::interval and f.modified_at < now() - ?::interval
order by f.modified_at asc order by f.modified_at asc
limit 10") limit 10")
(defn retrieve-candidates (defn retrieve-candidates
"Retrieves a list of ids of files that are candidates to be trimed. A
file is considered candidate when some time passes whith no
modification."
[conn] [conn]
(let [interval (:file-trimming-max-age cfg/config)] (let [threshold (:file-trimming-threshold cfg/config)
(->> (db/exec! conn [sql:retrieve-files-to-trim interval]) interval (db/interval threshold)]
(map :id)))) (db/exec! conn [sql:retrieve-files-to-trim interval])))
(def collect-media-xf
(comp
(map :objects)
(mapcat vals)
(filter #(= :image (:type %)))
(map :metadata)
(map :id)))
(defn collect-used-media (defn collect-used-media
[pages] [data]
(let [xf (comp (filter #(= :image (:type %))) (-> #{}
(map :metadata) (into collect-media-xf (vals (:pages-index data)))
(map :id))] (into collect-media-xf (vals (:components data)))
(reduce conj #{} (->> pages (into (keys (:media data)))))
(map :data)
(map :objects)
(mapcat vals)
(filter #(= :image (:type %)))
(map :metadata)
(map :id)))))
(defn process-file (defn process-file
[file-id] [{:keys [id data] :as file}]
(log/debugf "Processing file: '%s'." file-id) (log/debugf "Processing file: '%s'." id)
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [mobjs (db/query conn :media-object {:file-id file-id}) (let [mobjs (map :id (db/query conn :media-object {:file-id id}))
pages (->> (db/query conn :page {:file-id file-id}) data (-> (blob/decode data)
(map decode-row)) (pmg/migrate-data))
used (collect-used-media pages)
unused (into #{} (comp (map :id) used (collect-used-media data)
(remove #(contains? used %))) mobjs)] unused (into #{} (remove #(contains? used %)) mobjs)]
(log/debugf "Collected media ids: '%s'." (pr-str used)) (log/debugf "Collected media ids: '%s'." (pr-str used))
(log/debugf "Unused media ids: '%s'." (pr-str unused)) (log/debugf "Unused media ids: '%s'." (pr-str unused))
(db/update! conn :file (db/update! conn :file
{:has-media-trimmed true} {:has-media-trimmed true}
{:id file-id}) {:id id})
(doseq [id unused] (doseq [id unused]
;; TODO: add task batching
(tasks/submit! conn {:name "delete-object" (tasks/submit! conn {:name "delete-object"
;; :delay cfg/default-deletion-delay ;; :delay cfg/default-deletion-delay
:delay 10000 :delay 10000
@ -86,7 +92,7 @@
nil))) nil)))
(defn handler (defn handler
[{:keys [props] :as task}] [_task]
(log/debug "Running 'trim-file' task.") (log/debug "Running 'trim-file' task.")
(loop [] (loop []
(let [files (retrieve-candidates db/pool)] (let [files (retrieve-candidates db/pool)]

5
backend/src/app/util/async.clj
View File

@ -6,9 +6,8 @@
(ns app.util.async (ns app.util.async
(:require (:require
[clojure.spec.alpha :as s] [clojure.core.async :as a]
[clojure.tools.logging :as log] [clojure.spec.alpha :as s])
[clojure.core.async :as a])
(:import (:import
java.util.concurrent.Executor)) java.util.concurrent.Executor))

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

@ -12,7 +12,7 @@
;; TODO: move to app.common.helpers ;; TODO: move to app.common.helpers
(defn dissoc-in (defn dissoc-in
[m [k & ks :as keys]] [m [k & ks]]
(if ks (if ks
(if-let [nextmap (get m k)] (if-let [nextmap (get m k)]
(let [newmap (dissoc-in nextmap ks)] (let [newmap (dissoc-in nextmap ks)]

11
backend/src/app/util/dispatcher.clj
View File

@ -8,14 +8,11 @@
"A generic service dispatcher implementation." "A generic service dispatcher implementation."
(:refer-clojure :exclude [defmethod]) (:refer-clojure :exclude [defmethod])
(:require (:require
[clojure.spec.alpha :as s] [app.common.exceptions :as ex]
[expound.alpha :as expound] [clojure.spec.alpha :as s])
[app.common.exceptions :as ex])
(:import (:import
clojure.lang.IDeref java.util.HashMap
clojure.lang.MapEntry java.util.Map))
java.util.Map
java.util.HashMap))
(definterface IDispatcher (definterface IDispatcher
(^void add [key f])) (^void add [key f]))

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

@ -5,27 +5,25 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.util.emails (ns app.util.emails
(:require (:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.util.template :as tmpl]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str])
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.util.template :as tmpl])
(:import (:import
java.util.Properties java.util.Properties
javax.mail.Message
javax.mail.Transport
javax.mail.Message$RecipientType javax.mail.Message$RecipientType
javax.mail.PasswordAuthentication
javax.mail.Session javax.mail.Session
javax.mail.Transport
javax.mail.internet.InternetAddress javax.mail.internet.InternetAddress
javax.mail.internet.MimeMultipart
javax.mail.internet.MimeBodyPart javax.mail.internet.MimeBodyPart
javax.mail.internet.MimeMessage)) javax.mail.internet.MimeMessage
javax.mail.internet.MimeMultipart))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Email Building ;; Email Building
@ -205,8 +203,7 @@
(defn- build-email-template (defn- build-email-template
[id context] [id context]
(let [lang (:lang context :en) (let [subj (render-email-template-part :subj id context)
subj (render-email-template-part :subj id context)
text (render-email-template-part :txt id context) text (render-email-template-part :txt id context)
html (render-email-template-part :html id context)] html (render-email-template-part :html id context)]
(when (or (not subj) (when (or (not subj)

10
backend/src/app/util/http.clj
View File

@ -2,14 +2,16 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz> ;; 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.util.http (ns app.util.http
"Http client abstraction layer." "Http client abstraction layer."
(:require (:require
[promesa.core :as p] [java-http-clj.core :as http]
[promesa.exec :as px] [promesa.exec :as px]))
[java-http-clj.core :as http]))
(def default-client (def default-client
(delay (http/build-client {:executor @px/default-executor}))) (delay (http/build-client {:executor @px/default-executor})))

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

@ -2,13 +2,16 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz> ;; 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.util.migrations (ns app.util.migrations
(:require (:require
[clojure.tools.logging :as log]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str] [cuerdas.core :as str]
[next.jdbc :as jdbc])) [next.jdbc :as jdbc]))
@ -45,7 +48,7 @@
((:fn migration) pool)))) ((:fn migration) pool))))
(defn- impl-migrate (defn- impl-migrate
[conn migrations {:keys [fake] :or {fake false}}] [conn migrations _opts]
(s/assert ::migrations migrations) (s/assert ::migrations migrations)
(let [mname (:name migrations) (let [mname (:name migrations)
steps (:steps migrations)] steps (:steps migrations)]

14
backend/src/app/util/redis.clj
View File

@ -2,14 +2,17 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz> ;; 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.util.redis (ns app.util.redis
"Asynchronous posgresql client." "Asynchronous posgresql client."
(:refer-clojure :exclude [run!]) (:refer-clojure :exclude [run!])
(:require (:require
[promesa.core :as p] [clojure.core.async :as a]
[clojure.core.async :as a]) [promesa.core :as p])
(:import (:import
io.lettuce.core.RedisClient io.lettuce.core.RedisClient
io.lettuce.core.RedisURI io.lettuce.core.RedisURI
@ -18,7 +21,6 @@
io.lettuce.core.api.StatefulRedisConnection io.lettuce.core.api.StatefulRedisConnection
io.lettuce.core.pubsub.RedisPubSubListener io.lettuce.core.pubsub.RedisPubSubListener
io.lettuce.core.pubsub.StatefulRedisPubSubConnection io.lettuce.core.pubsub.StatefulRedisPubSubConnection
io.lettuce.core.pubsub.api.async.RedisPubSubAsyncCommands
io.lettuce.core.pubsub.api.sync.RedisPubSubCommands io.lettuce.core.pubsub.api.sync.RedisPubSubCommands
)) ))
@ -87,7 +89,7 @@
output)) output))
(defn subscribe (defn subscribe
[{:keys [uri] :as client} {:keys [topic topics xform]}] [{:keys [uri] :as client} {:keys [topics xform]}]
(let [topics (if (vector? topics) (let [topics (if (vector? topics)
(into-array String (map str topics)) (into-array String (map str topics))
(into-array String [(str topics)]))] (into-array String [(str topics)]))]
@ -100,7 +102,7 @@
true true
false)) false))
(defmulti impl-run (fn [conn cmd parmas] cmd)) (defmulti impl-run (fn [_ cmd _] cmd))
(defn run! (defn run!
[conn cmd params] [conn cmd params]

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

@ -164,7 +164,7 @@
(defn- process-param-tokens (defn- process-param-tokens
[sql] [sql]
(let [cnt (java.util.concurrent.atomic.AtomicInteger. 1)] (let [cnt (java.util.concurrent.atomic.AtomicInteger. 1)]
(str/replace sql #"\?" (fn [& args] (str/replace sql #"\?" (fn [& _args]
(str "$" (.getAndIncrement cnt)))))) (str "$" (.getAndIncrement cnt))))))
(def ^:private select-formatters (def ^:private select-formatters

13
backend/src/app/util/storage.clj
View File

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.util.storage (ns app.util.storage
"A local filesystem storage implementation." "A local filesystem storage implementation."
@ -16,17 +16,14 @@
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.core :as fs] [datoteka.core :as fs])
[datoteka.proto :as fp])
(:import (:import
java.io.ByteArrayInputStream java.io.ByteArrayInputStream
java.io.InputStream java.io.InputStream
java.io.OutputStream java.io.OutputStream
java.net.URI java.net.URI
java.nio.file.Files
java.nio.file.NoSuchFileException java.nio.file.NoSuchFileException
java.nio.file.Path java.nio.file.Path))
java.security.MessageDigest))
(defn uri (defn uri
[v] [v]
@ -54,7 +51,7 @@
(defn- transform-path (defn- transform-path
[storage ^Path path] [storage ^Path path]
(if-let [xf (::xf storage)] (if-let [xf (::xf storage)]
((xf (fn [a b] b)) nil path) ((xf (fn [_ b] b)) nil path)
path)) path))
(defn blob (defn blob
@ -89,7 +86,7 @@
(normalize-path (::base-path storage)) (normalize-path (::base-path storage))
(fs/delete)) (fs/delete))
true true
(catch java.nio.file.NoSuchFileException e (catch NoSuchFileException _e
false))) false)))
(defn clear! (defn clear!

22
backend/src/app/util/svg.clj
View File

@ -2,21 +2,23 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz> ;; 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.util.svg (ns app.util.svg
"Icons SVG parsing helpers." "Icons SVG parsing helpers."
(:require (:require
[clojure.spec.alpha :as s] [app.common.exceptions :as ex]
[cuerdas.core :as str]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.exceptions :as ex]) [clojure.spec.alpha :as s]
[cuerdas.core :as str])
(:import (:import
org.jsoup.Jsoup org.jsoup.Jsoup
org.jsoup.nodes.Attribute org.jsoup.nodes.Attribute
org.jsoup.nodes.Element org.jsoup.nodes.Element
org.jsoup.nodes.Document org.jsoup.nodes.Document))
java.io.InputStream))
(s/def ::content string?) (s/def ::content string?)
(s/def ::width ::us/number) (s/def ::width ::us/number)
@ -65,19 +67,19 @@
content (.html element) content (.html element)
attrs (parse-attrs element)] attrs (parse-attrs element)]
(assoc attrs :content content)) (assoc attrs :content content))
(catch java.lang.IllegalArgumentException e (catch java.lang.IllegalArgumentException _e
(ex/raise :type :validation (ex/raise :type :validation
:code ::invalid-input :code ::invalid-input
:message "Input does not seems to be a valid svg.")) :message "Input does not seems to be a valid svg."))
(catch java.lang.NullPointerException e (catch java.lang.NullPointerException _e
(ex/raise :type :validation (ex/raise :type :validation
:code ::invalid-input :code ::invalid-input
:message "Input does not seems to be a valid svg.")) :message "Input does not seems to be a valid svg."))
(catch org.jsoup.UncheckedIOException e (catch org.jsoup.UncheckedIOException _e
(ex/raise :type :validation (ex/raise :type :validation
:code ::invalid-input :code ::invalid-input
:message "Input does not seems to be a valid svg.")) :message "Input does not seems to be a valid svg."))
(catch Exception e (catch Exception _e
(ex/raise :type :internal (ex/raise :type :internal
:code ::unexpected)))) :code ::unexpected))))

13
backend/src/app/util/template.clj
View File

@ -2,18 +2,17 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz> ;; 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.util.template (ns app.util.template
"A lightweight abstraction over mustache.java template engine. "A lightweight abstraction over mustache.java template engine.
The documentation can be found: http://mustache.github.io/mustache.5.html" The documentation can be found: http://mustache.github.io/mustache.5.html"
(:require (:require
[clojure.tools.logging :as log] [app.common.exceptions :as ex]
[clojure.walk :as walk] [selmer.parser :as sp]))
[clojure.java.io :as io]
[cuerdas.core :as str]
[selmer.parser :as sp]
[app.common.exceptions :as ex]))
;; (sp/cache-off!) ;; (sp/cache-off!)

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

@ -5,12 +5,12 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.util.time (ns app.util.time
(:require (:require
[clojure.spec.alpha :as s]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[clojure.spec.alpha :as s]
[cognitect.transit :as t]) [cognitect.transit :as t])
(:import (:import
java.time.Instant java.time.Instant
@ -103,10 +103,11 @@
(letfn [(conformer [v] (letfn [(conformer [v]
(cond (cond
(duration? v) v (duration? v) v
(string? v) (string? v)
(try (try
(parse-duration v) (duration v)
(catch java.time.format.DateTimeParseException e (catch java.time.format.DateTimeParseException _e
::s/invalid)) ::s/invalid))
:else :else

10
backend/src/app/util/transit.clj
View File

@ -9,13 +9,11 @@
(ns app.util.transit (ns app.util.transit
(:require (:require
[cognitect.transit :as t] [app.common.geom.matrix :as gmt]
[clojure.java.io :as io]
[linked.core :as lk]
[app.util.time :as dt]
[app.util.data :as data]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.matrix :as gmt]) [app.util.time :as dt]
[cognitect.transit :as t]
[linked.core :as lk])
(:import (:import
linked.set.LinkedSet linked.set.LinkedSet
java.io.ByteArrayInputStream java.io.ByteArrayInputStream

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

@ -15,12 +15,11 @@
[app.db :as db] [app.db :as db]
[app.tasks.delete-object] [app.tasks.delete-object]
[app.tasks.delete-profile] [app.tasks.delete-profile]
[app.tasks.remove-media]
[app.tasks.maintenance] [app.tasks.maintenance]
[app.tasks.remove-media]
[app.tasks.sendmail] [app.tasks.sendmail]
[app.tasks.trim-file] [app.tasks.trim-file]
[app.util.async :as aa] [app.util.async :as aa]
[app.util.blob :as blob]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -31,10 +30,7 @@
org.eclipse.jetty.util.thread.QueuedThreadPool org.eclipse.jetty.util.thread.QueuedThreadPool
java.util.concurrent.ExecutorService java.util.concurrent.ExecutorService
java.util.concurrent.Executors java.util.concurrent.Executors
java.util.concurrent.Executor java.time.Instant))
java.time.Duration
java.time.Instant
java.util.Date))
(declare start-scheduler-worker!) (declare start-scheduler-worker!)
(declare start-worker!) (declare start-worker!)
@ -61,19 +57,18 @@
:fn #'app.tasks.trim-file/handler} :fn #'app.tasks.trim-file/handler}
{:id "maintenance/delete-executed-tasks" {:id "maintenance/delete-executed-tasks"
:cron #app/cron "0 0 */1 * * ?" ;; hourly :cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn #'app.tasks.maintenance/delete-executed-tasks :fn #'app.tasks.maintenance/delete-executed-tasks
:props {:max-age #app/duration "48h"}} :props {:max-age #app/duration "24h"}}
{:id "maintenance/delete-old-files-xlog" {:id "maintenance/delete-old-files-xlog"
:cron #app/cron "0 0 */1 * * ?" ;; hourly :cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn #'app.tasks.maintenance/delete-old-files-xlog :fn #'app.tasks.maintenance/delete-old-files-xlog
:props {:max-age #app/duration "8h"}} :props {:max-age #app/duration "12h"}}
]) ])
(defstate executor (defstate executor
:start (thread-pool {:idle-timeout 10000 :start (thread-pool {:min-threads 0
:min-threads 0
:max-threads 256}) :max-threads 256})
:stop (stop! executor)) :stop (stop! executor))
@ -149,7 +144,7 @@
nil)))) nil))))
(defn- run-task (defn- run-task
[{:keys [tasks conn]} item] [{:keys [tasks]} item]
(try (try
(log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)) (log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))
(handle-task tasks item) (handle-task tasks item)
@ -187,7 +182,7 @@
for update skip locked") for update skip locked")
(defn- event-loop-fn* (defn- event-loop-fn*
[{:keys [tasks executor batch-size] :as opts}] [{:keys [executor batch-size] :as opts}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(let [queue (:queue opts "default") (let [queue (:queue opts "default")
items (->> (db/exec! conn [sql:select-next-tasks queue batch-size]) items (->> (db/exec! conn [sql:select-next-tasks queue batch-size])
@ -222,7 +217,7 @@
:opt-un [::poll-interval])) :opt-un [::poll-interval]))
(defn start-worker! (defn start-worker!
[{:keys [poll-interval executor] [{:keys [poll-interval]
:or {poll-interval 5000} :or {poll-interval 5000}
:as opts}] :as opts}]
(us/assert ::start-worker-params opts) (us/assert ::start-worker-params opts)
@ -290,7 +285,7 @@
do update set cron_expr=?") do update set cron_expr=?")
(defn- synchronize-schedule-item (defn- synchronize-schedule-item
[conn {:keys [id cron] :as item}] [conn {:keys [id cron]}]
(let [cron (str cron)] (let [cron (str cron)]
(log/debugf "Initialize scheduled task '%s' (cron: '%s')." id cron) (log/debugf "Initialize scheduled task '%s' (cron: '%s')." id cron)
(db/exec-one! conn [sql:upsert-scheduled-task id cron cron]))) (db/exec-one! conn [sql:upsert-scheduled-task id cron cron])))
@ -311,7 +306,7 @@
(.printStackTrace ^Throwable error (java.io.PrintWriter. *out*)))) (.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
(defn- execute-scheduled-task (defn- execute-scheduled-task
[{:keys [scheduler executor] :as opts} {:keys [id cron] :as task}] [{:keys [executor] :as opts} {:keys [id] :as task}]
(letfn [(run-task [conn] (letfn [(run-task [conn]
(try (try
(when (db/exec-one! conn [sql:lock-scheduled-task id]) (when (db/exec-one! conn [sql:lock-scheduled-task id])
@ -384,8 +379,8 @@
(defn thread-pool (defn thread-pool
([] (thread-pool {})) ([] (thread-pool {}))
([{:keys [min-threads max-threads idle-timeout name] ([{:keys [min-threads max-threads name]
:or {min-threads 0 max-threads 128 idle-timeout 60000}}] :or {min-threads 0 max-threads 256}}]
(let [executor (QueuedThreadPool. max-threads min-threads)] (let [executor (QueuedThreadPool. max-threads min-threads)]
(.setName executor (or name "default-tp")) (.setName executor (or name "default-tp"))
(.start executor) (.start executor)

15
backend/tests/app/tests/helpers.clj
View File

@ -17,7 +17,7 @@
[mount.core :as mount] [mount.core :as mount]
[environ.core :refer [env]] [environ.core :refer [env]]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.services.init] [app.services]
[app.services.mutations.profile :as profile] [app.services.mutations.profile :as profile]
[app.services.mutations.projects :as projects] [app.services.mutations.projects :as projects]
[app.services.mutations.teams :as teams] [app.services.mutations.teams :as teams]
@ -36,9 +36,9 @@
[] []
(doto (PGSimpleDataSource.) (doto (PGSimpleDataSource.)
(.setServerName "postgres") (.setServerName "postgres")
(.setDatabaseName "uxbox_test") (.setDatabaseName "penpot_test")
(.setUser "uxbox") (.setUser "penpot")
(.setPassword "uxbox"))) (.setPassword "penpot")))
(defn state-init (defn state-init
[next] [next]
@ -50,8 +50,8 @@
#'app.redis/client #'app.redis/client
#'app.redis/conn #'app.redis/conn
#'app.media/semaphore #'app.media/semaphore
#'app.services.init/query-services #'app.services/query-services
#'app.services.init/mutation-services #'app.services/mutation-services
#'app.migrations/migrations #'app.migrations/migrations
#'app.media-storage/assets-storage #'app.media-storage/assets-storage
#'app.media-storage/media-storage}) #'app.media-storage/media-storage})
@ -91,7 +91,8 @@
(let [params {:id (mk-uuid "profile" i) (let [params {:id (mk-uuid "profile" i)
:fullname (str "Profile " i) :fullname (str "Profile " i)
:email (str "profile" i ".test@nodomain.com") :email (str "profile" i ".test@nodomain.com")
:password "123123"}] :password "123123"
:demo? true}]
(->> (#'profile/create-profile conn params) (->> (#'profile/create-profile conn params)
(#'profile/create-profile-relations conn)))) (#'profile/create-profile-relations conn))))

94
backend/tests/app/tests/test_common_geom.clj Normal file
View File

@ -0,0 +1,94 @@
;; 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.tests.test_common_geom
(:require
[clojure.test :as t]
[app.common.geom.point :as gpt]
[app.common.geom.matrix :as gmt]))
(t/deftest point-constructors-test
(t/testing "Create point with both coordinates"
(let [p (gpt/point 1 2)]
(t/is (= (:x p) 1))
(t/is (= (:y p) 2))))
(t/testing "Create point with single coordinate"
(let [p (gpt/point 1)]
(t/is (= (:x p) 1))
(t/is (= (:y p) 1))))
(t/testing "Create empty point"
(let [p (gpt/point)]
(t/is (= (:x p) 0))
(t/is (= (:y p) 0)))))
(t/deftest point-add-test
(t/testing "Adds two points together"
(let [p1 (gpt/point 1 1)
p2 (gpt/point 2 2)
p3 (gpt/add p1 p2)]
(t/is (= (:x p3) 3))
(t/is (= (:y p3) 3)))))
(t/deftest point-subtract-test
(t/testing "Point substraction"
(let [p1 (gpt/point 3 3)
p2 (gpt/point 2 2)
p3 (gpt/subtract p1 p2)]
(t/is (= (:x p3) 1))
(t/is (= (:y p3) 1)))))
(t/deftest point-distance-test
(let [p1 (gpt/point 0 0)
p2 (gpt/point 10 0)
d (gpt/distance p1 p2)]
(t/is (number? d))
(t/is (= d 10.0))))
(t/deftest point-length-test
(let [p1 (gpt/point 10 0)
ln (gpt/length p1)]
(t/is (number? ln))
(t/is (= ln 10.0))))
(t/deftest point-angle-test
(t/testing "Get angle a 90 degree angle"
(let [p1 (gpt/point 0 10)
angle (gpt/angle p1)]
(t/is (number? angle))
(t/is (= angle 90.0))))
(t/testing "Get 45 degree angle"
(let [p1 (gpt/point 0 10)
p2 (gpt/point 10 10)
angle (gpt/angle-with-other p1 p2)]
(t/is (number? angle))
(t/is (= angle 45.0)))))
(t/deftest matrix-constructors-test
(let [m (gmt/matrix)]
(t/is (= (str m) "matrix(1,0,0,1,0,0)")))
(let [m (gmt/matrix 1 1 1 2 2 2)]
(t/is (= (str m) "matrix(1,1,1,2,2,2)"))))
(t/deftest matrix-translate-test
(let [m (-> (gmt/matrix)
(gmt/translate (gpt/point 2 10)))]
(t/is (= (str m) "matrix(1,0,0,1,2,10)"))))
(t/deftest matrix-scale-test
(let [m (-> (gmt/matrix)
(gmt/scale (gpt/point 2)))]
(t/is (= (str m) "matrix(2,0,0,2,0,0)"))))
(t/deftest matrix-rotate-test
(let [m (-> (gmt/matrix)
(gmt/rotate 10))]
(t/is (= (str m) "matrix(0.984807753012208,0.17364817766693033,-0.17364817766693033,0.984807753012208,0,0)"))))

179
backend/tests/app/tests/test_common_geom_shapes.clj Normal file
View File

@ -0,0 +1,179 @@
;; 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.tests.test-common-geom-shapes
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages :refer [make-minimal-shape]]
[clojure.test :as t]))
(def default-path [{:command :move-to :params {:x 0 :y 0}}
{:command :line-to :params {:x 20 :y 20}}
{:command :line-to :params {:x 30 :y 30}}
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}])
(defn add-path-data [shape]
(let [content (:content shape default-path)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
(assoc shape
:content content
:selrect selrect
:points points)))
(defn add-rect-data [shape]
(let [selrect (gsh/rect->selrect shape)
points (gsh/rect->points selrect)]
(assoc shape
:selrect selrect
:points points)))
(defn create-test-shape
([type] (create-test-shape type {}))
([type params]
(-> (make-minimal-shape type)
(merge params)
(cond->
(= type :path) (add-path-data)
(not= type :path) (add-rect-data)))))
(t/deftest transform-shape-tests
(t/testing "Shape without modifiers should stay the same"
(t/are [type]
(let [shape-before (create-test-shape type)
shape-after (gsh/transform-shape shape-before)]
(= shape-before shape-after))
:rect :path))
(t/testing "Transform shape with translation modifiers"
(t/are [type]
(let [modifiers {:displacement (gmt/translate-matrix (gpt/point 10 -10))}]
(let [shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/is (not= shape-before shape-after))
(t/is (== (get-in shape-before [:selrect :x])
(- 10 (get-in shape-after [:selrect :x]))))
(t/is (== (get-in shape-before [:selrect :y])
(+ 10 (get-in shape-after [:selrect :y]))))
(t/is (== (get-in shape-before [:selrect :width])
(get-in shape-after [:selrect :width])))
(t/is (== (get-in shape-before [:selrect :height])
(get-in shape-after [:selrect :height])))))
:rect :path))
(t/testing "Transform with empty translation"
(t/are [type]
(let [modifiers {:displacement (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/are [prop]
(t/is (== (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
:x :y :width :height :x1 :y1 :x2 :y2))
:rect :path))
(t/testing "Transform shape with resize modifiers"
(t/are [type]
(let [modifiers {:resize-origin (gpt/point 0 0)
:resize-vector (gpt/point 2 2)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/is (not= shape-before shape-after))
(t/is (== (get-in shape-before [:selrect :x])
(get-in shape-after [:selrect :x])))
(t/is (== (get-in shape-before [:selrect :y])
(get-in shape-after [:selrect :y])))
(t/is (== (* 2 (get-in shape-before [:selrect :width]))
(get-in shape-after [:selrect :width])))
(t/is (== (* 2 (get-in shape-before [:selrect :height]))
(get-in shape-after [:selrect :height]))))
:rect :path))
(t/testing "Transform with empty resize"
(t/are [type]
(let [modifiers {:resize-origin (gpt/point 0 0)
:resize-vector (gpt/point 1 1)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/are [prop]
(t/is (== (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
:x :y :width :height :x1 :y1 :x2 :y2))
:rect :path))
(t/testing "Transform with resize=0"
(t/are [type]
(let [modifiers {:resize-origin (gpt/point 0 0)
:resize-vector (gpt/point 0 0)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/is (> (get-in shape-before [:selrect :width])
(get-in shape-after [:selrect :width])))
(t/is (> (get-in shape-after [:selrect :width]) 0))
(t/is (> (get-in shape-before [:selrect :height])
(get-in shape-after [:selrect :height])))
(t/is (> (get-in shape-after [:selrect :height]) 0)))
:rect :path))
(t/testing "Transform shape with rotation modifiers"
(t/are [type]
(let [modifiers {:rotation 30}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/is (not= shape-before shape-after))
(t/is (not (== (get-in shape-before [:selrect :x])
(get-in shape-after [:selrect :x]))))
(t/is (not (== (get-in shape-before [:selrect :y])
(get-in shape-after [:selrect :y])))))
:rect :path))
(t/testing "Transform shape with rotation = 0 should leave equal selrect"
(t/are [type]
(let [modifiers {:rotation 0}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/are [prop]
(t/is (== (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
:x :y :width :height :x1 :y1 :x2 :y2))
:rect :path))
(t/testing "Transform shape with invalid selrect fails gracefuly"
(t/are [type selrect]
(let [modifiers {:displacement (gmt/matrix)}
shape-before (-> (create-test-shape type {:modifiers modifiers})
(assoc :selrect selrect))
shape-after (gsh/transform-shape shape-before)]
(= (:selrect shape-before) (:selrect shape-after)))
:rect {:x 0 :y 0 :width ##Inf :height ##Inf}
:path {:x 0 :y 0 :width ##Inf :height ##Inf}
:rect nil
:path nil)))

6
backend/tests/app/tests/test_emails.clj
View File

@ -23,10 +23,10 @@
(let [result (emails/render emails/register {:to "example@app.io" :name "foo"})] (let [result (emails/render emails/register {:to "example@app.io" :name "foo"})]
(t/is (map? result)) (t/is (map? result))
(t/is (contains? result :subject)) (t/is (contains? result :subject))
(t/is (contains? result :content)) (t/is (contains? result :body))
(t/is (contains? result :to)) (t/is (contains? result :to))
(t/is (contains? result :reply-to)) #_(t/is (contains? result :reply-to))
(t/is (vector? (:content result))))) (t/is (vector? (:body result)))))
;; (t/deftest email-sending-and-sendmail-job ;; (t/deftest email-sending-and-sendmail-job
;; (let [res @(emails/send! emails/register {:to "example@app.io" :name "foo"})] ;; (let [res @(emails/send! emails/register {:to "example@app.io" :name "foo"})]

12
backend/tests/app/tests/test_services_media.clj
View File

@ -78,13 +78,13 @@
(t/is (string? (get-in out [:result :path]))) (t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path]))))) (t/is (string? (get-in out [:result :thumb-path])))))
(t/testing "list media objects by file" #_(t/testing "list media objects by file"
(let [data {::sq/type :media-objects (let [data {::sq/type :media-objects
:profile-id (:id prof) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:is-local true} :is-local true}
out (th/try-on! (sq/handle data))] out (th/try-on! (sq/handle data))]
;; (th/print-result! out) (th/print-result! out)
;; Result is ordered by creation date descendent ;; Result is ordered by creation date descendent
(t/is (= object-id-2 (get-in out [:result 0 :id]))) (t/is (= object-id-2 (get-in out [:result 0 :id])))
@ -96,7 +96,7 @@
(t/is (string? (get-in out [:result 0 :path]))) (t/is (string? (get-in out [:result 0 :path])))
(t/is (string? (get-in out [:result 0 :thumb-path]))))) (t/is (string? (get-in out [:result 0 :thumb-path])))))
(t/testing "single media object" #_(t/testing "single media object"
(let [data {::sq/type :media-object (let [data {::sq/type :media-object
:profile-id (:id prof) :profile-id (:id prof)
:id object-id-2} :id object-id-2}
@ -111,7 +111,7 @@
(t/is (string? (get-in out [:result :path]))))) (t/is (string? (get-in out [:result :path])))))
(t/testing "delete media objects" #_(t/testing "delete media objects"
(let [data {::sm/type :delete-media-object (let [data {::sm/type :delete-media-object
:profile-id (:id prof) :profile-id (:id prof)
:id object-id-1} :id object-id-1}
@ -121,7 +121,7 @@
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (nil? (:result out))))) (t/is (nil? (:result out)))))
(t/testing "query media object after delete" #_(t/testing "query media object after delete"
(let [data {::sq/type :media-object (let [data {::sq/type :media-object
:profile-id (:id prof) :profile-id (:id prof)
:id object-id-1} :id object-id-1}
@ -136,7 +136,7 @@
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))) (t/is (th/ex-of-type? error :not-found)))))
(t/testing "query media objects after delete" #_(t/testing "query media objects after delete"
(let [data {::sq/type :media-objects (let [data {::sq/type :media-objects
:profile-id (:id prof) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)

2
backend/tests/app/tests/test_services_profile.clj
View File

@ -40,7 +40,7 @@
(let [error (ex-cause (:error out))] (let [error (ex-cause (:error out))]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation)) (t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :app.services.mutations.profile/wrong-credentials))))) (t/is (th/ex-of-code? error :wrong-credentials)))))
(t/testing "success" (t/testing "success"
(let [event {::sm/type :login (let [event {::sm/type :login

9
backend/tests/app/tests/test_services_viewer.clj
View File

@ -43,7 +43,7 @@
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
(t/is (contains? result :share-token)) (t/is (contains? result :token))
(t/is (contains? result :page)) (t/is (contains? result :page))
(t/is (contains? result :file)) (t/is (contains? result :file))
(t/is (contains? result :project))))) (t/is (contains? result :project)))))
@ -78,12 +78,13 @@
(let [error (ex-cause (:error out)) (let [error (ex-cause (:error out))
error-data (ex-data error)] error-data (ex-data error)]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found))))) (t/is (= (:type error-data) :validation))
(t/is (= (:code error-data) :not-authorized)))))
(t/testing "authenticated with token & profile" (t/testing "authenticated with token & profile"
(let [data {::sq/type :viewer-bundle (let [data {::sq/type :viewer-bundle
:profile-id (:id prof2) :profile-id (:id prof2)
:share-token @token :token @token
:file-id (:id file) :file-id (:id file)
:page-id (get-in file [:data :pages 0])} :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] out (th/try-on! (sq/handle data))]
@ -97,7 +98,7 @@
(t/testing "authenticated with token" (t/testing "authenticated with token"
(let [data {::sq/type :viewer-bundle (let [data {::sq/type :viewer-bundle
:share-token @token :token @token
:file-id (:id file) :file-id (:id file)
:page-id (get-in file [:data :pages 0])} :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] out (th/try-on! (sq/handle data))]

71
common/app/common/attrs.cljc Normal file
View File

@ -0,0 +1,71 @@
;; 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.attrs)
(defn get-attrs-multi
[shapes attrs]
;; Extract some attributes of a list of shapes.
;; For each attribute, if the value is the same in all shapes,
;; wll take this value. If there is any shape that is different,
;; the value of the attribute will be the keyword :multiple.
;;
;; If some shape has the value nil in any attribute, it's
;; considered a different value. If the shape does not contain
;; the attribute, it's ignored in the final result.
;;
;; Example:
;; (def shapes [{:stroke-color "#ff0000"
;; :stroke-width 3
;; :fill-color "#0000ff"
;; :x 1000 :y 2000 :rx nil}
;; {:stroke-width "#ff0000"
;; :stroke-width 5
;; :x 1500 :y 2000}])
;;
;; (get-attrs-multi shapes [:stroke-color
;; :stroke-width
;; :fill-color
;; :rx
;; :ry])
;; >>> {:stroke-color "#ff0000"
;; :stroke-width :multiple
;; :fill-color "#0000ff"
;; :rx nil
;; :ry nil}
;;
(let [defined-shapes (filter some? shapes)
combine-value (fn [v1 v2] (cond
(= v1 v2) v1
(= v1 :undefined) v2
(= v2 :undefined) v1
:else :multiple))
combine-values (fn [attrs shape values]
(map #(combine-value (get shape % :undefined)
(get values % :undefined)) attrs))
select-attrs (fn [shape attrs]
(zipmap attrs (map #(get shape % :undefined) attrs)))
reducer (fn [result shape]
(zipmap attrs (combine-values attrs shape result)))
combined (reduce reducer
(select-attrs (first defined-shapes) attrs)
(rest defined-shapes))
cleanup-value (fn [value]
(if (= value :undefined) nil value))
cleanup (fn [result]
(zipmap attrs (map #(cleanup-value (get result %)) attrs)))]
(cleanup combined)))

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

@ -6,13 +6,17 @@
(ns app.common.data (ns app.common.data
"Data manipulation and query helper functions." "Data manipulation and query helper functions."
(:refer-clojure :exclude [concat read-string hash-map]) (:refer-clojure :exclude [concat read-string hash-map merge])
(:require [clojure.set :as set] #?(:cljs
[linked.set :as lks] (:require-macros [app.common.data]))
#?(:cljs [cljs.reader :as r] (:require
:clj [clojure.edn :as r]) [linked.set :as lks]
#?(:cljs [cljs.core :as core] [app.common.math :as mth]
:clj [clojure.core :as core])) #?(:clj [cljs.analyzer.api :as aapi])
#?(:cljs [cljs.reader :as r]
:clj [clojure.edn :as r])
#?(:cljs [cljs.core :as core]
:clj [clojure.core :as core]))
#?(:clj #?(:clj
(:import linked.set.LinkedSet))) (:import linked.set.LinkedSet)))
@ -35,7 +39,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn dissoc-in (defn dissoc-in
[m [k & ks :as keys]] [m [k & ks]]
(if ks (if ks
(if-let [nextmap (get m k)] (if-let [nextmap (get m k)]
(let [newmap (dissoc-in nextmap ks)] (let [newmap (dissoc-in nextmap ks)]
@ -85,7 +89,7 @@
(defn index-of-pred (defn index-of-pred
[coll pred] [coll pred]
(loop [c (first coll) (loop [c (first coll)
coll (rest coll) coll (rest coll)
index 0] index 0]
(if (nil? c) (if (nil? c)
@ -206,6 +210,17 @@
(assoc m key v) (assoc m key v)
m))) m)))
(defn merge
"A faster merge."
[& maps]
(loop [res (transient (or (first maps) {}))
maps (next maps)]
(if (nil? maps)
(persistent! res)
(recur (reduce-kv assoc! res (first maps))
(next maps)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion ;; Data Parsing / Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -219,7 +234,7 @@
#?(:cljs (js/parseInt v 10) #?(:cljs (js/parseInt v 10)
:clj (try :clj (try
(Integer/parseInt v) (Integer/parseInt v)
(catch Throwable e (catch Throwable _
nil)))) nil))))
(defn- impl-parse-double (defn- impl-parse-double
@ -227,7 +242,7 @@
#?(:cljs (js/parseFloat v) #?(:cljs (js/parseFloat v)
:clj (try :clj (try
(Double/parseDouble v) (Double/parseDouble v)
(catch Throwable e (catch Throwable _
nil)))) nil))))
(defn parse-integer (defn parse-integer
@ -261,3 +276,59 @@
(defn coalesce (defn coalesce
[val default] [val default]
(or val default)) (or val default))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn nilf
"Returns a new function that if you pass nil as any argument will
return nil"
[f]
(fn [& args]
(if (some nil? args)
nil
(apply f args))))
(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) (mth/nan? v)) 0 v))
(defmacro export
"A helper macro that allows reexport a var in a current namespace."
[v]
(if (boolean (:ns &env))
;; Code for ClojureScript
(let [mdata (aapi/resolve &env v)
arglists (second (get-in mdata [:meta :arglists]))
sym (symbol (name v))
andsym (symbol "&")
procarg #(if (= % andsym) % (gensym "param"))]
(if (pos? (count arglists))
`(def
~(with-meta sym (:meta mdata))
(fn ~@(for [args arglists]
(let [args (map procarg args)]
(if (some #(= andsym %) args)
(let [[sargs dargs] (split-with #(not= andsym %) args)]
`([~@sargs ~@dargs] (apply ~v ~@sargs ~@(rest dargs))))
`([~@args] (~v ~@args)))))))
`(def ~(with-meta sym (:meta mdata)) ~v)))
;; Code for Clojure
(let [vr (resolve v)
m (meta vr)
n (:name m)
n (with-meta n
(cond-> {}
(:dynamic m) (assoc :dynamic true)
(:protocol m) (assoc :protocol (:protocol m))))]
`(let [m# (meta ~vr)]
(def ~n (deref ~vr))
(alter-meta! (var ~n) merge (dissoc m# :name))
;; (when (:macro m#)
;; (.setMacro (var ~n)))
~vr))))

8
common/app/common/exceptions.cljc
View File

@ -6,6 +6,8 @@
(ns app.common.exceptions (ns app.common.exceptions
"A helpers for work with exceptions." "A helpers for work with exceptions."
#?(:cljs
(:require-macros [app.common.exceptions]))
(:require [clojure.spec.alpha :as s])) (:require [clojure.spec.alpha :as s]))
(s/def ::type keyword?) (s/def ::type keyword?)
@ -22,7 +24,7 @@
::cause])) ::cause]))
(defn error (defn error
[& {:keys [type code message hint cause] :as params}] [& {:keys [message hint cause] :as params}]
(s/assert ::error-params params) (s/assert ::error-params params)
(let [message (or message hint "") (let [message (or message hint "")
payload (dissoc params :cause)] payload (dissoc params :cause)]
@ -46,3 +48,7 @@
(defmacro try (defmacro try
[& exprs] [& exprs]
`(try* (^:once fn* [] ~@exprs) identity)) `(try* (^:once fn* [] ~@exprs) identity))
(defn ex-info?
[v]
(instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v))

151
common/app/common/geom/align.cljc Normal file
View File

@ -0,0 +1,151 @@
;; 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.align
(:require
[clojure.spec.alpha :as s]
[app.common.geom.shapes :as gsh]
[app.common.data :as d]))
;; --- Alignment
(s/def ::align-axis #{:hleft :hcenter :hright :vtop :vcenter :vbottom})
(declare calc-align-pos)
;; Duplicated from pages/helpers to remove cyclic dependencies
(defn- get-children [id objects]
(let [shapes (vec (get-in objects [id :shapes]))]
(if shapes
(d/concat shapes (mapcat #(get-children % objects) shapes))
[])))
(defn- recursive-move
"Move the shape and all its recursive children."
[shape dpoint objects]
(let [children-ids (get-children (:id shape) objects)
children (map #(get objects %) children-ids)]
(map #(gsh/move % dpoint) (cons shape children))))
(defn align-to-rect
"Move the shape so that it is aligned with the given rectangle
in the given axis. Take account the form of the shape and the
possible rotation. What is aligned is the rectangle that wraps
the shape with the given rectangle. If the shape is a group,
move also all of its recursive children."
[shape rect axis objects]
(let [wrapper-rect (gsh/selection-rect [shape])
align-pos (calc-align-pos wrapper-rect rect axis)
delta {:x (- (:x align-pos) (:x wrapper-rect))
:y (- (:y align-pos) (:y wrapper-rect))}]
(recursive-move shape delta objects)))
(defn calc-align-pos
[wrapper-rect rect axis]
(case axis
:hleft (let [left (:x rect)]
{:x left
:y (:y wrapper-rect)})
:hcenter (let [center (+ (:x rect) (/ (:width rect) 2))]
{:x (- center (/ (:width wrapper-rect) 2))
:y (:y wrapper-rect)})
:hright (let [right (+ (:x rect) (:width rect))]
{:x (- right (:width wrapper-rect))
:y (:y wrapper-rect)})
:vtop (let [top (:y rect)]
{:x (:x wrapper-rect)
:y top})
:vcenter (let [center (+ (:y rect) (/ (:height rect) 2))]
{:x (:x wrapper-rect)
:y (- center (/ (:height wrapper-rect) 2))})
:vbottom (let [bottom (+ (:y rect) (:height rect))]
{:x (:x wrapper-rect)
:y (- bottom (:height wrapper-rect))})))
;; --- Distribute
(s/def ::dist-axis #{:horizontal :vertical})
(defn distribute-space
"Distribute equally the space between shapes in the given axis. If
there is no space enough, it does nothing. It takes into account
the form of the shape and the rotation, what is distributed is
the wrapping recangles of the shapes. If any shape is a group,
move also all of its recursive children."
[shapes axis objects]
(let [coord (if (= axis :horizontal) :x :y)
other-coord (if (= axis :horizontal) :y :x)
size (if (= axis :horizontal) :width :height)
; The rectangle that wraps the whole selection
wrapper-rect (gsh/selection-rect shapes)
; Sort shapes by the center point in the given axis
sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes)
; Each shape wrapped in its own rectangle
wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
; The total space between shapes
space (reduce - (size wrapper-rect) (map size wrapped-shapes))]
(if (<= space 0)
shapes
(let [unit-space (/ space (- (count wrapped-shapes) 1))
; Calculate the distance we need to move each shape.
; The new position of each one is the position of the
; previous one plus its size plus the unit space.
deltas (loop [shapes' wrapped-shapes
start-pos (coord wrapper-rect)
deltas []]
(let [first-shape (first shapes')
delta (- start-pos (coord first-shape))
new-pos (+ start-pos (size first-shape) unit-space)]
(if (= (count shapes') 1)
(conj deltas delta)
(recur (rest shapes')
new-pos
(conj deltas delta)))))]
(mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
sorted-shapes deltas)))))
;; Adjusto to viewport
(defn adjust-to-viewport
([viewport srect] (adjust-to-viewport viewport srect nil))
([viewport srect {:keys [padding] :or {padding 0}}]
(let [gprop (/ (:width viewport) (:height viewport))
srect (-> srect
(update :x #(- % padding))
(update :y #(- % padding))
(update :width #(+ % padding padding))
(update :height #(+ % padding padding)))
width (:width srect)
height (:height srect)
lprop (/ width height)]
(cond
(> gprop lprop)
(let [width' (* (/ width lprop) gprop)
padding (/ (- width' width) 2)]
(-> srect
(update :x #(- % padding))
(assoc :width width')))
(< gprop lprop)
(let [height' (/ (* height lprop) gprop)
padding (/ (- height' height) 2)]
(-> srect
(update :y #(- % padding))
(assoc :height height')))
:else srect))))

21
common/app/common/geom/matrix.cljc
View File

@ -9,7 +9,6 @@
(ns app.common.geom.matrix (ns app.common.geom.matrix
(:require (:require
[cuerdas.core :as str]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.geom.point :as gpt])) [app.common.geom.point :as gpt]))
@ -21,8 +20,8 @@
(str "matrix(" a "," b "," c "," d "," e "," f ")"))) (str "matrix(" a "," b "," c "," d "," e "," f ")")))
(defn multiply (defn multiply
([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f :as m1} ([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f :as m2}] {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
(Matrix. (Matrix.
(+ (* m1a m2a) (* m1c m2b)) (+ (* m1a m2a) (* m1c m2b))
(+ (* m1b m2a) (* m1d m2b)) (+ (* m1b m2a) (* m1d m2b))
@ -34,8 +33,8 @@
(reduce multiply (multiply m1 m2) others))) (reduce multiply (multiply m1 m2) others)))
(defn substract (defn substract
[{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f :as m1} [{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f :as m2}] {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
(Matrix. (Matrix.
(- m1a m2a) (- m1b m2b) (- m1c m2c) (- m1a m2a) (- m1b m2b) (- m1c m2c)
(- m1d m2d) (- m1e m2e) (- m1f m2f))) (- m1d m2d) (- m1e m2e) (- m1f m2f)))
@ -88,7 +87,7 @@
(defn skew-matrix (defn skew-matrix
([angle-x angle-y point] ([angle-x angle-y point]
(multiply (translate-matrix point) (multiply (translate-matrix point)
(skew-matrix angle-y angle-y) (skew-matrix angle-x angle-y)
(translate-matrix (gpt/negate point)))) (translate-matrix (gpt/negate point))))
([angle-x angle-y] ([angle-x angle-y]
(let [m1 (mth/tan (mth/radians angle-x)) (let [m1 (mth/tan (mth/radians angle-x))
@ -121,3 +120,13 @@
([m angle-x angle-y p] ([m angle-x angle-y p]
(multiply m (skew-matrix angle-x angle-y p)))) (multiply m (skew-matrix angle-x angle-y p))))
(defn m-equal [m1 m2 threshold]
(let [th-eq (fn [a b] (<= (mth/abs (- a b)) threshold))
{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f} m1
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f} m2]
(and (th-eq m1a m2a)
(th-eq m1b m2b)
(th-eq m1c m2c)
(th-eq m1d m2d)
(th-eq m1e m2e)
(th-eq m1f m2f))))

44
common/app/common/geom/point.cljc
View File

@ -12,7 +12,6 @@
(:require (:require
#?(:cljs [cljs.core :as c] #?(:cljs [cljs.core :as c]
:clj [clojure.core :as c]) :clj [clojure.core :as c])
[cuerdas.core :as str]
[app.common.math :as mth])) [app.common.math :as mth]))
;; --- Point Impl ;; --- Point Impl
@ -26,6 +25,14 @@
[v] [v]
(instance? Point v)) (instance? Point v))
(defn ^boolean point-like?
[{:keys [x y] :as v}]
(and (map? v)
(not (nil? x))
(not (nil? y))
(number? x)
(number? y)))
(defn point (defn point
"Create a Point instance." "Create a Point instance."
([] (Point. 0 0)) ([] (Point. 0 0))
@ -37,9 +44,20 @@
(number? v) (number? v)
(Point. v v) (Point. v v)
(point-like? v)
(Point. (:x v) (:y v))
:else :else
(throw (ex-info "Invalid arguments" {:v v})))) (throw (ex-info "Invalid arguments" {:v v}))))
([x y] (Point. x y))) ([x y]
;;(assert (not (nil? x)))
;;(assert (not (nil? y)))
(Point. x y)))
(defn angle->point [{:keys [x y]} angle distance]
(point
(+ x (* distance (mth/cos angle)))
(- y (* distance (mth/sin angle)))))
(defn add (defn add
"Returns the addition of the supplied value to both "Returns the addition of the supplied value to both
@ -134,14 +152,18 @@
(assert (point? p)) (assert (point? p))
(assert (point? other)) (assert (point? other))
(let [a (/ (+ (* x ox) (let [length-p (length p)
(* y oy)) length-other (length other)]
(* (length p) (if (or (mth/almost-zero? length-p)
(length other))) (mth/almost-zero? length-other))
a (mth/acos (if (< a -1) -1 (if (> a 1) 1 a))) 0
d (-> (mth/degrees a) (let [a (/ (+ (* x ox)
(mth/precision 6))] (* y oy))
(if (mth/nan? d) 0 d))) (* length-p length-other))
a (mth/acos (if (< a -1) -1 (if (> a 1) 1 a)))
d (-> (mth/degrees a)
(mth/precision 6))]
(if (mth/nan? d) 0 d)))))
(defn update-angle (defn update-angle
@ -173,7 +195,7 @@
(defn transform (defn transform
"Transform a point applying a matrix transfomation." "Transform a point applying a matrix transfomation."
[{:keys [x y] :as p} {:keys [a b c d e f] :as m}] [{:keys [x y] :as p} {:keys [a b c d e f]}]
(assert (point? p)) (assert (point? p))
(Point. (+ (* x a) (* y c) e) (Point. (+ (* x a) (* y c) e)
(+ (* x b) (* y d) f))) (+ (* x b) (* y d) f)))

52
common/app/common/geom/proportions.cljc Normal file
View File

@ -0,0 +1,52 @@
;; 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.proportions)
;; --- Proportions
(declare assign-proportions-path)
(declare assign-proportions-rect)
(defn assign-proportions
[{:keys [type] :as shape}]
(case type
:path (assign-proportions-path shape)
(assign-proportions-rect shape)))
(defn- assign-proportions-rect
[{:keys [width height] :as shape}]
(assoc shape :proportion (/ width height)))
;; --- Setup Proportions
(declare setup-proportions-const)
(declare setup-proportions-image)
(defn setup-proportions
[shape]
(case (:type shape)
:icon (setup-proportions-image shape)
:image (setup-proportions-image shape)
:text shape
(setup-proportions-const shape)))
(defn setup-proportions-image
[{:keys [metadata] :as shape}]
(let [{:keys [width height]} metadata]
(assoc shape
:proportion (/ width height)
:proportion-lock false)))
(defn setup-proportions-const
[shape]
(assoc shape
:proportion 1
:proportion-lock false))

907
common/app/common/geom/shapes.cljc
View File

@ -9,67 +9,26 @@
(ns app.common.geom.shapes (ns app.common.geom.shapes
(:require (:require
[clojure.spec.alpha :as s] [app.common.data :as d]
[app.common.spec :as us]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.math :as mth] [app.common.geom.shapes.common :as gco]
[app.common.data :as d])) [app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
(defn- nilf [app.common.geom.shapes.transforms :as gtr]
"Returns a new function that if you pass nil as any argument will [app.common.spec :as us]))
return nil"
[f]
(fn [& args]
(if (some nil? args)
nil
(apply f args))))
;; --- Relative Movement ;; --- Relative Movement
(declare move-rect)
(declare move-path)
(defn -chk
"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) (mth/nan? v)) 0 v))
(defn move (defn move
"Move the shape relativelly to its current "Move the shape relativelly to its current
position applying the provided delta." position applying the provided delta."
[shape {dx :x dy :y}] [shape {dx :x dy :y}]
(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx)))) (let [dx (d/check-num dx)
inc-y (nilf (fn [y] (+ (-chk y) (-chk dy)))) dy (d/check-num dy)]
inc-point (nilf (fn [p] (-> p
(update :x inc-x)
(update :y inc-y))))]
(-> shape (-> shape
(update :x inc-x) (assoc-in [:modifiers :displacement] (gmt/translate-matrix (gpt/point dx dy)))
(update :y inc-y) (gtr/transform-shape))))
(update-in [:selrect :x] inc-x)
(update-in [:selrect :x1] inc-x)
(update-in [:selrect :x2] inc-x)
(update-in [:selrect :y] inc-y)
(update-in [:selrect :y1] inc-y)
(update-in [:selrect :y2] inc-y)
(update :points #(mapv inc-point %))
(update :segments #(mapv inc-point %)))))
;; Duplicated from pages-helpers to remove cyclic dependencies
(defn get-children [id objects]
(let [shapes (vec (get-in objects [id :shapes]))]
(if shapes
(d/concat shapes (mapcat #(get-children % objects) shapes))
[])))
(defn recursive-move
"Move the shape and all its recursive children."
[shape dpoint objects]
(let [children-ids (get-children (:id shape) objects)
children (map #(get objects %) children-ids)]
(map #(move % dpoint) (cons shape children))))
;; --- Absolute Movement ;; --- Absolute Movement
@ -77,116 +36,35 @@
(defn absolute-move (defn absolute-move
"Move the shape to the exactly specified position." "Move the shape to the exactly specified position."
[shape position] [shape {:keys [x y]}]
(case (:type shape) (let [dx (- (d/check-num x) (-> shape :selrect :x))
(:curve :path) shape dy (- (d/check-num y) (-> shape :selrect :y))]
(absolute-move-rect shape position)))
(defn- absolute-move-rect
"A specialized function for absolute moviment
for rect-like shapes."
[shape {:keys [x y] :as pos}]
(let [dx (if x (- (-chk x) (-chk (:x shape))) 0)
dy (if y (- (-chk y) (-chk (:y shape))) 0)]
(move shape (gpt/point dx dy)))) (move shape (gpt/point dx dy))))
;; --- Center
(declare center-rect)
(declare center-path)
(defn center
"Calculate the center of the shape."
[shape]
(case (:type shape)
:curve (center-path shape)
:path (center-path shape)
(center-rect shape)))
(defn- center-rect
[{:keys [x y width height] :as shape}]
(gpt/point (+ x (/ width 2)) (+ y (/ height 2))))
(defn- center-path
[{:keys [segments] :as shape}]
(let [minx (apply min (map :x segments))
miny (apply min (map :y segments))
maxx (apply max (map :x segments))
maxy (apply max (map :y segments))]
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2))))
(defn center->rect
"Creates a rect given a center and a width and height"
[center width height]
{:x (- (:x center) (/ width 2))
:y (- (:y center) (/ height 2))
:width width
:height height})
;; --- Proportions
(declare assign-proportions-path)
(declare assign-proportions-rect)
(defn assign-proportions
[{:keys [type] :as shape}]
(case type
:path (assign-proportions-path shape)
(assign-proportions-rect shape)))
(defn- assign-proportions-rect
[{:keys [width height] :as shape}]
(assoc shape :proportion (/ width height)))
;; --- Paths
(defn update-path-point
"Update a concrete point in the path.
The point should exists before, this function
does not adds it automatically."
[shape index point]
(assoc-in shape [:segments index] point))
;; --- Setup Proportions
(declare setup-proportions-const)
(declare setup-proportions-image)
(defn setup-proportions
[shape]
(case (:type shape)
:icon (setup-proportions-image shape)
:image (setup-proportions-image shape)
:text shape
(setup-proportions-const shape)))
(defn setup-proportions-image
[{:keys [metadata] :as shape}]
(let [{:keys [width height]} metadata]
(assoc shape
:proportion (/ width height)
:proportion-lock false)))
(defn setup-proportions-const
[shape]
(assoc shape
:proportion 1
:proportion-lock false))
;; --- Resize (Dimensions) ;; --- Resize (Dimensions)
(defn resize (defn resize
[shape width height] [shape width height]
(us/assert map? shape) (us/assert map? shape)
(us/assert number? width) (us/assert number? width)
(us/assert number? height) (us/assert number? height)
(-> shape
(assoc :width width :height height) (let [shape-transform (:transform shape (gmt/matrix))
(update :selrect (fn [selrect] shape-transform-inv (:transform-inverse shape (gmt/matrix))
(assoc selrect shape-center (gco/center-shape shape)
:x2 (+ (:x1 selrect) width) {sr-width :width sr-height :height} (:selrect shape)
:y2 (+ (:y1 selrect) height)))))) origin (-> (gpt/point (:selrect shape))
(gtr/transform-point-center shape-center shape-transform))
scalev (gpt/divide (gpt/point width height)
(gpt/point sr-width sr-height))]
(-> shape
(update :modifiers assoc
:resize-vector scalev
:resize-origin origin
:resize-transform shape-transform
:resize-transform-inverse shape-transform-inv)
(gtr/transform-shape))))
(defn resize-rect (defn resize-rect
[shape attr value] [shape attr value]
@ -207,9 +85,29 @@
(resize shape (:width new-size) (:height new-size)))) (resize shape (:width new-size) (:height new-size))))
;; --- Setup (Initialize) ;; --- Setup (Initialize)
;; FIXME: Is this the correct place for these functions?
(declare setup-rect) (defn- setup-rect
(declare setup-image) "A specialized function for setup rect-like shapes."
[shape {:keys [x y width height]}]
(let [rect {:x x :y y :width width :height height}
points (gpr/rect->points rect)
selrect (gpr/points->selrect points)]
(assoc shape
:x x
:y y
:width width
:height height
:points points
:selrect selrect)))
(defn- setup-image
[{:keys [metadata] :as shape} props]
(-> (setup-rect shape props)
(assoc
:proportion (/ (:width metadata)
(:height metadata))
:proportion-lock true)))
(defn setup (defn setup
"A function that initializes the first coordinates for "A function that initializes the first coordinates for
@ -219,324 +117,45 @@
:image (setup-image shape props) :image (setup-image shape props)
(setup-rect shape props))) (setup-rect shape props)))
(declare shape->points)
(declare points->selrect)
(defn- setup-rect
"A specialized function for setup rect-like shapes."
[shape {:keys [x y width height]}]
(as-> shape $
(assoc $ :x x
:y y
:width width
:height height)
(assoc $ :points (shape->points $))
(assoc $ :selrect (points->selrect (:points $)))))
(defn- setup-image
[{:keys [metadata] :as shape} {:keys [x y width height] :as props}]
(-> (setup-rect shape props)
(assoc
:proportion (/ (:width metadata)
(:height metadata))
:proportion-lock true)))
;; --- Coerce to Rect-like shape.
(declare path->rect-shape)
(declare group->rect-shape)
(declare rect->rect-shape)
;; TODO: completly remove
(defn shape->rect-shape
"Coerce shape to rect like shape."
[{:keys [type] :as shape}]
(case type
(:curve :path) (path->rect-shape shape)
(rect->rect-shape shape)))
;; -- Points
(declare transform-shape-point)
(defn shape->points [shape]
(let [points (case (:type shape)
(:curve :path) (:segments shape)
(let [{:keys [x y width height]} shape]
[(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))]))]
(->> points
(map #(transform-shape-point % shape (:transform shape (gmt/matrix))))
(map gpt/round)
(vec))))
(defn points->selrect [points]
(let [minx (transduce (map :x) min ##Inf points)
miny (transduce (map :y) min ##Inf points)
maxx (transduce (map :x) max ##-Inf points)
maxy (transduce (map :y) max ##-Inf points)]
{:x1 minx
:y1 miny
:x2 maxx
:y2 maxy
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny)
:type :rect}))
;; Shape->PATH
(declare rect->path)
(defn shape->path
[shape]
(case (:type shape)
(:curve :path) shape
(rect->path shape)))
(defn rect->path
[{:keys [x y width height] :as shape}]
(let [points [(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))
(gpt/point x y)]]
(-> shape
(assoc :type :path)
(assoc :segments points))))
;; --- SHAPE -> RECT
(defn- rect->rect-shape
[{:keys [x y width height] :as shape}]
(assoc shape
:x1 x
:y1 y
:x2 (+ x width)
:y2 (+ y height)))
(defn- path->rect-shape
[{:keys [segments] :as shape}]
(merge shape
{:type :rect}
(:selrect shape)))
;; --- Resolve Shape
(declare resolve-rect-shape)
(declare translate-from-frame)
(declare translate-to-frame)
(defn resolve-shape
[objects shape]
(case (:type shape)
:rect (resolve-rect-shape objects shape)
:group (resolve-rect-shape objects shape)
:frame (resolve-rect-shape objects shape)))
(defn- resolve-rect-shape
[objects {:keys [parent] :as shape}]
(loop [pobj (get objects parent)]
(if (= :frame (:type pobj))
(translate-from-frame shape pobj)
(recur (get objects (:parent pobj))))))
;; --- Transform Shape
(declare transform-rect)
(declare transform-path)
(defn transform
"Apply the matrix transformation to shape."
[{:keys [type] :as shape} xfmt]
(if (gmt/matrix? xfmt)
(case type
:path (transform-path shape xfmt)
:curve (transform-path shape xfmt)
(transform-rect shape xfmt))
shape))
(defn center-transform [shape matrix]
(let [shape-center (center shape)]
(-> shape
(transform
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply matrix)
(gmt/translate (gpt/negate shape-center)))))))
(defn- transform-rect
[{:keys [x y width height] :as shape} mx]
(let [tl (gpt/transform (gpt/point x y) mx)
tr (gpt/transform (gpt/point (+ x width) y) mx)
bl (gpt/transform (gpt/point x (+ y height)) mx)
br (gpt/transform (gpt/point (+ x width) (+ y height)) mx)
;; TODO: replace apply with transduce (performance)
minx (apply min (map :x [tl tr bl br]))
maxx (apply max (map :x [tl tr bl br]))
miny (apply min (map :y [tl tr bl br]))
maxy (apply max (map :y [tl tr bl br]))]
(assoc shape
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny))))
(defn- transform-path
[{:keys [segments] :as shape} xfmt]
(let [segments (mapv #(gpt/transform % xfmt) segments)]
(assoc shape :segments segments)))
;; --- Outer Rect ;; --- Outer Rect
(defn selection-rect (defn selection-rect
"Returns a rect that contains all the shapes and is aware of the "Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection." rotation of each shape. Mainly used for multiple selection."
[shapes] [shapes]
(let [shapes (map :selrect shapes) (->> shapes
minx (transduce (map :x1) min ##Inf shapes) (gtr/transform-shape)
miny (transduce (map :y1) min ##Inf shapes) (map (comp gpr/points->selrect :points))
maxx (transduce (map :x2) max ##-Inf shapes) (gpr/join-selrects)))
maxy (transduce (map :y2) max ##-Inf shapes)]
{:x1 minx
:y1 miny
:x2 maxx
:y2 maxy
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny)
:points [(gpt/point minx miny)
(gpt/point maxx miny)
(gpt/point maxx maxy)
(gpt/point minx maxy)]
:type :rect}))
(defn translate-to-frame (defn translate-to-frame
[shape {:keys [x y] :as frame}] [shape {:keys [x y]}]
(move shape (gpt/point (- x) (- y)))) (move shape (gpt/point (- x) (- y))))
(defn translate-from-frame (defn translate-from-frame
[shape {:keys [x y] :as frame}] [shape {:keys [x y]}]
(move shape (gpt/point x y))) (move shape (gpt/point x y)))
;; --- Alignment
(s/def ::align-axis #{:hleft :hcenter :hright :vtop :vcenter :vbottom})
(declare calc-align-pos)
(defn align-to-rect
"Move the shape so that it is aligned with the given rectangle
in the given axis. Take account the form of the shape and the
possible rotation. What is aligned is the rectangle that wraps
the shape with the given rectangle. If the shape is a group,
move also all of its recursive children."
[shape rect axis objects]
(let [wrapper-rect (selection-rect [shape])
align-pos (calc-align-pos wrapper-rect rect axis)
delta {:x (- (:x align-pos) (:x wrapper-rect))
:y (- (:y align-pos) (:y wrapper-rect))}]
(recursive-move shape delta objects)))
(defn calc-align-pos
[wrapper-rect rect axis]
(case axis
:hleft (let [left (:x rect)]
{:x left
:y (:y wrapper-rect)})
:hcenter (let [center (+ (:x rect) (/ (:width rect) 2))]
{:x (- center (/ (:width wrapper-rect) 2))
:y (:y wrapper-rect)})
:hright (let [right (+ (:x rect) (:width rect))]
{:x (- right (:width wrapper-rect))
:y (:y wrapper-rect)})
:vtop (let [top (:y rect)]
{:x (:x wrapper-rect)
:y top})
:vcenter (let [center (+ (:y rect) (/ (:height rect) 2))]
{:x (:x wrapper-rect)
:y (- center (/ (:height wrapper-rect) 2))})
:vbottom (let [bottom (+ (:y rect) (:height rect))]
{:x (:x wrapper-rect)
:y (- bottom (:height wrapper-rect))})))
;; --- Distribute
(s/def ::dist-axis #{:horizontal :vertical})
(defn distribute-space
"Distribute equally the space between shapes in the given axis. If
there is no space enough, it does nothing. It takes into account
the form of the shape and the rotation, what is distributed is
the wrapping recangles of the shapes. If any shape is a group,
move also all of its recursive children."
[shapes axis objects]
(let [coord (if (= axis :horizontal) :x :y)
other-coord (if (= axis :horizontal) :y :x)
size (if (= axis :horizontal) :width :height)
; The rectangle that wraps the whole selection
wrapper-rect (selection-rect shapes)
; Sort shapes by the center point in the given axis
sorted-shapes (sort-by #(coord (center %)) shapes)
; Each shape wrapped in its own rectangle
wrapped-shapes (map #(selection-rect [%]) sorted-shapes)
; The total space between shapes
space (reduce - (size wrapper-rect) (map size wrapped-shapes))]
(if (<= space 0)
shapes
(let [unit-space (/ space (- (count wrapped-shapes) 1))
; Calculate the distance we need to move each shape.
; The new position of each one is the position of the
; previous one plus its size plus the unit space.
deltas (loop [shapes' wrapped-shapes
start-pos (coord wrapper-rect)
deltas []]
(let [first-shape (first shapes')
delta (- start-pos (coord first-shape))
new-pos (+ start-pos (size first-shape) unit-space)]
(if (= (count shapes') 1)
(conj deltas delta)
(recur (rest shapes')
new-pos
(conj deltas delta)))))]
(mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
sorted-shapes deltas)))))
;; --- Helpers ;; --- Helpers
(defn contained-in? (defn contained-in?
"Check if a shape is contained in the "Check if a shape is contained in the
provided selection rect." provided selection rect."
[shape selrect] [shape selrect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (shape->rect-shape selrect) (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} selrect
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (shape->rect-shape shape)] {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (:selrect shape)]
(and (neg? (- sy1 ry1)) (and (neg? (- sy1 ry1))
(neg? (- sx1 rx1)) (neg? (- sx1 rx1))
(pos? (- sy2 ry2)) (pos? (- sy2 ry2))
(pos? (- sx2 rx2))))) (pos? (- sx2 rx2)))))
;; TODO: This not will work for rotated shapes
(defn overlaps? (defn overlaps?
"Check if a shape overlaps with provided selection rect." "Check if a shape overlaps with provided selection rect."
[shape selrect] [shape rect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (shape->rect-shape selrect) (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/rect->selrect rect)
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (shape->rect-shape shape)] {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/points->selrect (:points shape))]
(and (< rx1 sx2) (and (< rx1 sx2)
(> rx2 sx1) (> rx2 sx1)
(< ry1 sy2) (< ry1 sy2)
@ -564,43 +183,6 @@
:type :rect}] :type :rect}]
(overlaps? shape selrect))) (overlaps? shape selrect)))
(defn calculate-rec-path-skew-angle
[path-shape]
(let [p1 (get-in path-shape [:segments 2])
p2 (get-in path-shape [:segments 3])
p3 (get-in path-shape [:segments 4])
v1 (gpt/to-vec p1 p2)
v2 (gpt/to-vec p2 p3)]
(- 90 (gpt/angle-with-other v1 v2))))
(defn calculate-rec-path-height
"Calculates the height of a paralelogram given by the path"
[path-shape]
(let [p1 (get-in path-shape [:segments 2])
p2 (get-in path-shape [:segments 3])
p3 (get-in path-shape [:segments 4])
v1 (gpt/to-vec p1 p2)
v2 (gpt/to-vec p2 p3)
angle (gpt/angle-with-other v1 v2)]
(* (gpt/length v2) (mth/sin (mth/radians angle)))))
(defn calculate-rec-path-rotation
[path-shape1 path-shape2 resize-vector]
(let [idx-1 0
idx-2 (cond (and (neg? (:x resize-vector)) (pos? (:y resize-vector))) 1
(and (neg? (:x resize-vector)) (neg? (:y resize-vector))) 2
(and (pos? (:x resize-vector)) (neg? (:y resize-vector))) 3
:else 0)
p1 (get-in path-shape1 [:segments idx-1])
p2 (get-in path-shape2 [:segments idx-2])
v1 (gpt/to-vec (center path-shape1) p1)
v2 (gpt/to-vec (center path-shape2) p2)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
(* rot-sign rot-angle)))
(defn pad-selrec (defn pad-selrec
([selrect] (pad-selrec selrect 1)) ([selrect] (pad-selrec selrect 1))
([selrect size] ([selrect size]
@ -619,16 +201,22 @@
(defn selrect->areas [bounds selrect] (defn selrect->areas [bounds selrect]
(let [make-selrect (let [make-selrect
(fn [x1 y1 x2 y2] (fn [x1 y1 x2 y2]
{:x1 x1 :y1 y1 :x2 x2 :y2 y2 :x x1 :y y1 (let [x1 (min x1 x2)
:width (- x2 x1) :height (- y2 y1) :type :rect}) x2 (max x1 x2)
{frame-x1 :x1 frame-x2 :x2 frame-y1 :y1 frame-y2 :y2 y1 (min y1 y2)
frame-width :width frame-height :height} bounds y2 (max y1 y2)]
{sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2 {:x1 x1 :y1 y1
sr-width :width sr-height :height} selrect] :x2 x2 :y2 y2
{:left (make-selrect frame-x1 sr-y1 sr-x1 sr-y2) :x x1 :y y1
:top (make-selrect sr-x1 frame-y1 sr-x2 sr-y1) :width (- x2 x1)
:right (make-selrect sr-x2 sr-y1 frame-x2 sr-y2) :height (- y2 y1)
:bottom (make-selrect sr-x1 sr-y2 sr-x2 frame-y2)})) :type :rect}))
{frame-x1 :x1 frame-x2 :x2 frame-y1 :y1 frame-y2 :y2} bounds
{sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect]
{:left (make-selrect frame-x1 sr-y1 (- sr-x1 2) sr-y2)
:top (make-selrect sr-x1 frame-y1 sr-x2 (- sr-y1 2))
:right (make-selrect (+ sr-x2 2) sr-y1 frame-x2 sr-y2)
:bottom (make-selrect sr-x1 (+ sr-y2 2) sr-x2 frame-y2)}))
(defn distance-selrect [selrect other] (defn distance-selrect [selrect other]
(let [{:keys [x1 y1]} other (let [{:keys [x1 y1]} other
@ -658,310 +246,37 @@
(and (>= s1c1 s2c1) (<= s1c1 s2c2)) (and (>= s1c1 s2c1) (<= s1c1 s2c2))
(and (>= s1c2 s2c1) (<= s1c2 s2c2))))) (and (>= s1c2 s2c1) (<= s1c2 s2c2)))))
(defn transform-shape-point
"Transform a point around the shape center"
[point shape transform]
(let [shape-center (center shape)]
(gpt/transform
point
(-> (gmt/multiply
(gmt/translate-matrix shape-center)
transform
(gmt/translate-matrix (gpt/negate shape-center)))))))
(defn transform-apply-modifiers (defn setup-selrect [shape]
[shape] (let [selrect (gpr/rect->selrect shape)
(let [modifiers (:modifiers shape) points (gpr/rect->points shape)]
ds-modifier (:displacement modifiers (gmt/matrix)) (-> shape
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1)) (assoc :selrect selrect
:points points))))
;; Normalize x/y vector coordinates because scale by 0 is infinite (defn rotation-modifiers
res-x (cond [center shape angle]
(and (< res-x 0) (> res-x -0.01)) -0.01 (let [displacement (let [shape-center (gco/center-shape shape)]
(and (>= res-x 0) (< res-x 0.01)) 0.01 (-> (gmt/matrix)
:else res-x) (gmt/rotate angle center)
(gmt/rotate (- angle) shape-center)))]
res-y (cond {:rotation angle
(and (< res-y 0) (> res-y -0.01)) -0.01 :displacement displacement}))
(and (>= res-y 0) (< res-y 0.01)) 0.01
:else res-y)
resize (gpt/point res-x res-y)
origin (:resize-origin modifiers (gpt/point 0 0))
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0)
shape (-> shape
(transform ds-modifier))
shape-center (center shape)]
(-> (shape->path shape)
(transform (-> (gmt/matrix)
;; Applies the current resize transformation
(gmt/translate origin)
(gmt/multiply resize-transform)
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
;; Applies the stacked transformations
(gmt/translate shape-center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/multiply (:transform shape (gmt/matrix)))
(gmt/translate (gpt/negate shape-center)))))))
(defn rect-path-dimensions [rect-path]
(let [seg (:segments rect-path)
[width height] (mapv (fn [[c1 c2]] (gpt/distance c1 c2)) (take 2 (d/zip seg (rest seg))))]
{:width width
:height height}))
(defn calculate-stretch [shape-path transform-inverse]
(let [shape-center (center shape-path)
shape-path-temp (transform
shape-path
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply transform-inverse)
(gmt/translate (gpt/negate shape-center))))
shape-path-temp-rec (shape->rect-shape shape-path-temp)
shape-path-temp-dim (rect-path-dimensions shape-path-temp)]
(gpt/divide (gpt/point (:width shape-path-temp-rec) (:height shape-path-temp-rec))
(gpt/point (:width shape-path-temp-dim) (:height shape-path-temp-dim)))))
(defn fix-invalid-rect-values
[rect-shape]
(letfn [(check [num]
(if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num))
(to-positive [num] (if (< num 1) 1 num))]
(-> rect-shape
(update :x check)
(update :y check)
(update :width (comp to-positive check))
(update :height (comp to-positive check)))))
(defn transform-rect-shape
[shape]
(let [;; Apply modifiers to the rect as a path so we have the end shape expected
shape-path (transform-apply-modifiers shape)
shape-center (center shape-path)
resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1))
(update :x #(if (zero? %) 1 %))
(update :y #(if (zero? %) 1 %)))
;; Reverse the current transformation stack to get the base rectangle
shape-path-temp (center-transform shape-path (:transform-inverse shape (gmt/matrix)))
shape-path-temp-dim (rect-path-dimensions shape-path-temp)
shape-path-temp-rec (shape->rect-shape shape-path-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
;; to have this width, height, x, y
rec (center->rect shape-center (:width shape-path-temp-dim) (:height shape-path-temp-dim))
rec (fix-invalid-rect-values rec)
rec-path (rect->path rec)
;; The next matrix is a series of transformations we have to do to the previous rec so that
;; after applying them the end result is the `shape-path-temp`
;; This is compose of three transformations: skew, resize and rotation
stretch-matrix (gmt/matrix)
skew-angle (calculate-rec-path-skew-angle shape-path-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 (mth/nan? skew-angle) 0 skew-angle)
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0)) ;; EXPORTS
(d/export gco/center-shape)
h1 (calculate-rec-path-height shape-path-temp) (d/export gco/center-selrect)
h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix)) (d/export gco/center-rect)
h3 (/ h1 h2) (d/export gpr/rect->selrect)
h3 (if (mth/nan? h3) 1 h3) (d/export gpr/rect->points)
(d/export gpr/points->selrect)
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3))) (d/export gtr/transform-shape)
(d/export gtr/transform-matrix)
rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix) (d/export gtr/transform-point-center)
shape-path-temp resize-vector) (d/export gtr/transform-rect)
(d/export gtr/update-group-selrect)
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 h3))
(gmt/skew (- skew-angle) 0)
(gmt/rotate (- rotation-angle)))
new-shape (as-> shape $
(merge $ rec)
(update $ :x #(mth/precision % 0))
(update $ :y #(mth/precision % 0))
(update $ :width #(mth/precision % 0))
(update $ :height #(mth/precision % 0))
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix))
(update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix))))
(assoc $ :points (shape->points $))
(assoc $ :selrect (points->selrect (:points $)))
(update $ :selrect fix-invalid-rect-values)
(update $ :rotation #(mod (+ (or % 0)
(or (get-in $ [:modifiers :rotation]) 0)) 360)))]
new-shape))
(declare update-path-selrect)
(defn transform-path-shape
[shape]
(-> shape
transform-apply-modifiers
update-path-selrect)
;; TODO: Addapt for paths is not working
#_(let [shape-path (transform-apply-modifiers shape)
shape-path-center (center shape-path)
shape-transform-inverse' (-> (gmt/matrix)
(gmt/translate shape-path-center)
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
(gmt/translate (gpt/negate shape-path-center)))]
(-> shape-path
(transform shape-transform-inverse')
(add-rotate-transform (:rotation-modifier shape 0)))))
(defn transform-shape
"Transform the shape properties given the modifiers"
([shape] (transform-shape nil shape))
([frame shape]
(let [new-shape
(if (:modifiers shape)
(-> (case (:type shape)
(:curve :path) (transform-path-shape shape)
(transform-rect-shape shape))
(dissoc :modifiers))
shape)]
(cond-> new-shape
frame (translate-to-frame frame)))))
(defn transform-matrix
"Returns a transformation matrix without changing the shape properties.
The result should be used in a `transform` attribute in svg"
([{:keys [x y] :as shape}]
(let [shape-center (center shape)]
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply (:transform shape (gmt/matrix)))
(gmt/translate (gpt/negate shape-center))))))
(defn update-path-selrect [shape]
(as-> shape $
(assoc $ :points (shape->points $))
(assoc $ :selrect (points->selrect (:points $)))
(assoc $ :x (get-in $ [:selrect :x]))
(assoc $ :y (get-in $ [:selrect :y]))
(assoc $ :width (get-in $ [:selrect :width]))
(assoc $ :height (get-in $ [:selrect :height]))))
(defn adjust-to-viewport
([viewport srect] (adjust-to-viewport viewport srect nil))
([viewport srect {:keys [padding] :or {padding 0}}]
(let [gprop (/ (:width viewport) (:height viewport))
srect (-> srect
(update :x #(- % padding))
(update :y #(- % padding))
(update :width #(+ % padding padding))
(update :height #(+ % padding padding)))
width (:width srect)
height (:height srect)
lprop (/ width height)]
(cond
(> gprop lprop)
(let [width' (* (/ width lprop) gprop)
padding (/ (- width' width) 2)]
(-> srect
(update :x #(- % padding))
(assoc :width width')))
(< gprop lprop)
(let [height' (/ (* height lprop) gprop)
padding (/ (- height' height) 2)]
(-> srect
(update :y #(- % padding))
(assoc :height height')))
:else srect))))
(defn get-attrs-multi
[shapes attrs]
;; Extract some attributes of a list of shapes.
;; For each attribute, if the value is the same in all shapes,
;; wll take this value. If there is any shape that is different,
;; the value of the attribute will be the keyword :multiple.
;;
;; If some shape has the value nil in any attribute, it's
;; considered a different value. If the shape does not contain
;; the attribute, it's ignored in the final result.
;;
;; Example:
;; (def shapes [{:stroke-color "#ff0000"
;; :stroke-width 3
;; :fill-color "#0000ff"
;; :x 1000 :y 2000 :rx nil}
;; {:stroke-width "#ff0000"
;; :stroke-width 5
;; :x 1500 :y 2000}])
;;
;; (get-attrs-multi shapes [:stroke-color
;; :stroke-width
;; :fill-color
;; :rx
;; :ry])
;; >>> {:stroke-color "#ff0000"
;; :stroke-width :multiple
;; :fill-color "#0000ff"
;; :rx nil
;; :ry nil}
;;
(let [defined-shapes (filter some? shapes)
combine-value (fn [v1 v2] (cond
(= v1 v2) v1
(= v1 :undefined) v2
(= v2 :undefined) v1
:else :multiple))
combine-values (fn [attrs shape values]
(map #(combine-value (get shape % :undefined)
(get values % :undefined)) attrs))
select-attrs (fn [shape attrs]
(zipmap attrs (map #(get shape % :undefined) attrs)))
reducer (fn [result shape]
(zipmap attrs (combine-values attrs shape result)))
combined (reduce reducer
(select-attrs (first defined-shapes) attrs)
(rest defined-shapes))
cleanup-value (fn [value]
(if (= value :undefined) nil value))
cleanup (fn [result]
(zipmap attrs (map #(cleanup-value (get result %)) attrs)))]
(cleanup combined)))
(defn setup-selrect [{:keys [x y width height] :as shape}]
(-> shape
(assoc :selrect {:x x :y y
:width width :height height
:x1 x :y1 y
:x2 (+ x width) :y2 (+ y height)})))
;; PATHS
(d/export gsp/content->points)
(d/export gsp/content->selrect)

53
common/app/common/geom/shapes/common.cljc Normal file
View File

@ -0,0 +1,53 @@
;; 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.common
(:require
[app.common.geom.point :as gpt]
[app.common.math :as mth]))
(defn center-rect
[{:keys [x y width height]}]
(when (and (mth/finite? x)
(mth/finite? y)
(mth/finite? width)
(mth/finite? height))
(gpt/point (+ x (/ width 2))
(+ y (/ height 2)))))
(defn center-selrect
"Calculate the center of the shape."
[selrect]
(center-rect selrect))
(def map-x-xf (comp (map :x) (remove nil?)))
(def map-y-xf (comp (map :y) (remove nil?)))
(defn center-points [points]
(let [ptx (into [] map-x-xf points)
pty (into [] map-y-xf points)
minx (reduce min ##Inf ptx)
miny (reduce min ##Inf pty)
maxx (reduce max ##-Inf ptx)
maxy (reduce max ##-Inf pty)]
(gpt/point (/ (+ minx maxx) 2)
(/ (+ miny maxy) 2))))
(defn center-shape
"Calculate the center of the shape."
[shape]
(center-rect (:selrect shape)))
(defn make-centered-rect
"Creates a rect given a center and a width and height"
[center width height]
{:x (- (:x center) (/ width 2))
:y (- (:y center) (/ height 2))
:width width
:height height})

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