Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-27 23:21:47 -05:00
Code Issues Activity

Merge remote-tracking branch 'penpot/develop' into token-studio-develop

Browse source
This commit is contained in:
Florian Schroedl 2024-08-06 11:06:51 +02:00
commit 5fbbdd36fd
710 changed files with 33332 additions and 24717 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
.circleci/config.yml
View file

@ -22,10 +22,10 @@ jobs:
# Download and cache dependencies
- restore_cache:
keys:
- v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
# fallback to using the latest cache if no exact match is found
- v1-dependencies-
keys:
- v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
# fallback to using the latest cache if no exact match is found
- v1-dependencies-
- run: cd .clj-kondo && cat config.edn
- run: cat .cljfmt.edn
@ -58,6 +58,7 @@ jobs:
command: |
yarn install
yarn run fmt:clj:check
yarn run fmt:js:check
- run:
name: "common linter check"
@ -107,8 +108,8 @@ jobs:
working_directory: "./frontend"
command: |
yarn install
yarn run compile
yarn run compile:cljs
yarn run build:app:assets
clojure -M:dev:shadow-cljs release main
yarn playwright install --with-deps chromium
yarn e2e:test
@ -125,7 +126,6 @@ jobs:
PENPOT_TEST_REDIS_URI: "redis://localhost/1"
- save_cache:
paths:
- ~/.m2
key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
paths:
- ~/.m2
key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}

2
.clj-kondo/config.edn
View file

@ -3,7 +3,6 @@
promesa.core/->> clojure.core/->>
promesa.core/-> clojure.core/->
promesa.exec.csp/go-loop clojure.core/loop
rumext.v2/defc clojure.core/defn
promesa.util/with-open clojure.core/with-open
app.common.schema.generators/let clojure.core/let
app.common.data/export clojure.core/def
@ -20,6 +19,7 @@
app.db/with-atomic hooks.export/penpot-with-atomic
potok.v2.core/reify hooks.export/potok-reify
rumext.v2/fnc hooks.export/rumext-fnc
rumext.v2/defc hooks.export/rumext-defc
rumext.v2/lazy-component hooks.export/rumext-lazycomponent
shadow.lazy/loadable hooks.export/rumext-lazycomponent
}}

87
.clj-kondo/hooks/export.clj
View file

@ -12,6 +12,7 @@
(def registry (atom {}))
(defn potok-reify
[{:keys [:node :filename] :as params}]
(let [[rnode rtype & other] (:children node)
@ -66,12 +67,86 @@
(let [[cname mdata params & body] (rest (:children node))
[params body] (if (api/vector-node? mdata)
[mdata (cons params body)]
[params body])]
(let [result (api/list-node
(into [(api/token-node 'fn)
params]
(cons mdata body)))]
{:node result})))
[params body])
result (api/list-node
(into [(api/token-node 'fn) params]
(cons mdata body)))]
{:node result}))
(defn- parse-defc
[{:keys [children] :as node}]
(let [args (rest children)
[cname args]
(if (api/token-node? (first args))
[(first args) (rest args)]
(throw (ex-info "unexpected1" {})))
[docs args]
(if (api/string-node? (first args))
[(first args) (rest args)]
["" args])
[mdata args]
(if (api/map-node? (first args))
[(first args) (rest args)]
[(api/map-node []) args])
[params body]
(if (api/vector-node? (first args))
[(first args) (rest args)]
(throw (ex-info "unexpected2" {})))]
[cname docs mdata params body]))
(defn rumext-defc
[{:keys [node]}]
(let [[cname docs mdata params body] (parse-defc node)
param1 (first (:children params))
paramN (rest (:children params))
param1 (if (api/map-node? param1)
(let [param1 (into {} (comp
(partition-all 2)
(map (fn [[k v]]
[(if (api/keyword-node? k)
(:k k)
k)
(if (api/vector-node? v)
(vec (:children v))
v)])))
(:children param1))
binding (:rest param1)
param1 (if binding
(if (contains? param1 :as)
(update param1 :keys (fnil conj []) binding)
(assoc param1 :as binding))
param1)]
(->> (dissoc param1 :rest)
(mapcat (fn [[k v]]
[(if (keyword? k)
(api/keyword-node k)
k)
(if (vector? v)
(api/vector-node v)
v)]))
(api/map-node)))
param1)
result (api/list-node
(into [(api/token-node 'defn)
cname
(api/vector-node (filter some? (cons param1 paramN)))]
(cons mdata body)))]
;; (prn (api/sexpr result))
{:node result}))
(defn rumext-lazycomponent

1
.cljfmt.edn
View file

@ -4,6 +4,7 @@
:remove-consecutive-blank-lines? false
:extra-indents {rumext.v2/fnc [[:inner 0]]
cljs.test/async [[:inner 0]]
app.common.schema/register! [[:inner 0] [:inner 1]]
promesa.exec/thread [[:inner 0]]
specify! [[:inner 0] [:inner 1]]}
}

3
.gitignore vendored
View file

@ -48,6 +48,8 @@
/deploy
/docker/images/bundle*
/exporter/target
/frontend/.storybook/preview-body.html
/frontend/.storybook/preview-head.html
/frontend/cypress/fixtures/validuser.json
/frontend/cypress/videos/*/
/frontend/cypress/videos/*/
@ -68,7 +70,6 @@
/web
clj-profiler/
node_modules
frontend/.storybook/preview-body.html
/test-results/
/playwright-report/
/blob-report/

81
CHANGES.md
View file

@ -1,6 +1,6 @@
# CHANGELOG
## 2.1.0
## 2.2.0
### :rocket: Epics and highlights
@ -9,18 +9,87 @@
### :heart: Community contributions (Thank you!)
### :sparkles: New features
- Improve auth process [Taiga #Change Auth Process](https://tree.taiga.io/project/penpot/us/7094)
### :bug: Bugs fixed
- Fix components are not dragged from the group to the assets tab [Taiga #8273](https://tree.taiga.io/project/penpot/issue/8273)
## 2.1.1
### :sparkles: New features
- Consolidate templates new order and naming [Taiga #8392](https://tree.taiga.io/project/penpot/task/8392)
### :bug: Bugs fixed
- Fix the “search” label in translations [Taiga #8402](https://tree.taiga.io/project/penpot/issue/8402)
- Fix pencil loader [Taiga #8348](https://tree.taiga.io/project/penpot/issue/8348)
- Fix several issues on the OIDC.
- Fix regression on the `email-verification` flag [Taiga #8398](https://tree.taiga.io/project/penpot/issue/8398)
## 2.1.0 - Things can only get better!
### :rocket: Epics and highlights
### :boom: Breaking changes & Deprecations
### :heart: Community contributions (Thank you!)
### :sparkles: New features
- Improve auth process [Taiga #7094](https://tree.taiga.io/project/penpot/us/7094)
- Add locking degrees increment (hold shift) on path edition [Taiga #7761](https://tree.taiga.io/project/penpot/issue/7761)
- Persistence & Concurrent Edition Enhancements [Taiga #5657](https://tree.taiga.io/project/penpot/us/5657)
- Allow library colors as recent colors [Taiga #7640](https://tree.taiga.io/project/penpot/issue/7640)
- Missing scroll in viewmode comments [Taiga #7427](https://tree.taiga.io/project/penpot/issue/7427)
- Comments in View mode should mimic the positioning behavior of the Workspace [Taiga #7346](https://tree.taiga.io/project/penpot/issue/7346)
- Misaligned input on comments [Taiga #7461](https://tree.taiga.io/project/penpot/issue/7461)
### :bug: Bugs fixed
- Fix selection rectangle appears on scroll [Taiga #7525](https://tree.taiga.io/project/penpot/issue/7525)
- Fix layer tree not expanding to the bottom edge [Taiga #7466](https://tree.taiga.io/project/penpot/issue/7466)
- Fix guides move when board is moved by inputs [Taiga #8010](https://tree.taiga.io/project/penpot/issue/8010)
- Fix clickable area of Penptot logo in the viewer [Taiga #7988](https://tree.taiga.io/project/penpot/issue/7988)
- Fix constraints dropdown when selecting multiple shapes [Taiga #7686](https://tree.taiga.io/project/penpot/issue/7686)
- Layout and scrollign fixes for the bottom palette [Taiga #7559](https://tree.taiga.io/project/penpot/issue/7559)
- Fix expand libraries when search results are present [Taiga #7876](https://tree.taiga.io/project/penpot/issue/7876)
- Fix color palette default library [Taiga #8029](https://tree.taiga.io/project/penpot/issue/8029)
- Component Library is lost after exporting/importing in .zip format [Github #4672](https://github.com/penpot/penpot/issues/4672)
- Fix problem with moving+selection not working properly [Taiga #7943](https://tree.taiga.io/project/penpot/issue/7943)
- Fix problem with flex layout fit to content not positioning correctly children [Taiga #7537](https://tree.taiga.io/project/penpot/issue/7537)
- Fix black line is displaying after show main [Taiga #7653](https://tree.taiga.io/project/penpot/issue/7653)
- Fix "Share prototypes" modal remains open [Taiga #7442](https://tree.taiga.io/project/penpot/issue/7442)
- Fix "Components visibility and opacity" [#4694](https://github.com/penpot/penpot/issues/4694)
- Fix "Attribute overrides in copies are not exported in zip file" [Taiga #8072](https://tree.taiga.io/project/penpot/issue/8072)
- Fix group not automatically selected in the Layers panel after creation [Taiga #8078](https://tree.taiga.io/project/penpot/issue/8078)
- Fix export boards loses opacity [Taiga #7592](https://tree.taiga.io/project/penpot/issue/7592)
- Fix change color on imported svg also changes the stroke alignment[Taiga #7673](https://github.com/penpot/penpot/pull/7673)
- Fix show in view mode and interactions workflow [Taiga #4711](https://github.com/penpot/penpot/pull/4711)
- Fix internal error when I set up a stroke for some objects without and with stroke [Taiga #7558](https://tree.taiga.io/project/penpot/issue/7558)
- Toolbar keeps toggling on and off on spacebar press [Taiga #7654](https://github.com/penpot/penpot/pull/7654)
- Fix toolbar keeps hiding when click outside workspace [Taiga #7776](https://tree.taiga.io/project/penpot/issue/7776)
- Fix open overlay relative to a frame [Taiga #7563](https://tree.taiga.io/project/penpot/issue/7563)
- Workspace-palette items stay hidden when opening with keyboard-shortcut [Taiga #7489](https://tree.taiga.io/project/penpot/issue/7489)
- Fix SVG attrs are not handled correctly when exporting/importing in .zip [Taiga #7920](https://tree.taiga.io/project/penpot/issue/7920)
- Fix validation error when detaching with two nested copies and a swap [Taiga #8095](https://tree.taiga.io/project/penpot/issue/8095)
- Export shapes that are rotated act a bit strange when reimported [Taiga #7585](https://tree.taiga.io/project/penpot/issue/7585)
- Penpot crashes when a new colorpicker is created while uploading an image to another instance [Taiga #8119](https://tree.taiga.io/project/penpot/issue/8119)
- Removing Underline and Strikethrough Affects the Previous Text Object [Taiga #8103](https://tree.taiga.io/project/penpot/issue/8103)
- Color library loses association with shapes when exporting/importing the document [Taiga #8132](https://tree.taiga.io/project/penpot/issue/8132)
- Fix can't collapse groups when searching in the assets tab [Taiga #8125](https://tree.taiga.io/project/penpot/issue/8125)
- Fix 'Detach instance' shortcut is not working [Taiga #8102](https://tree.taiga.io/project/penpot/issue/8102)
- Fix import file message does not detect 0 as error [Taiga #6824](https://tree.taiga.io/project/penpot/issue/6824)
- Image Color Library is not persisted when exporting/importing in .zip [Taiga #8131](https://tree.taiga.io/project/penpot/issue/8131)
- Fix export files including libraries [Taiga #8266](https://tree.taiga.io/project/penpot/issue/8266)
## 2.0.3
### :bug: Bugs fixed
- Fix chrome scrollbar styling [Taiga Issue #7852](https://tree.taiga.io/project/penpot/issue/7852)
- Fix chrome scrollbar styling [Taiga #7852](https://tree.taiga.io/project/penpot/issue/7852)
- Fix incorrect password encoding on create-profile manage scritp [Github #3651](https://github.com/penpot/penpot/issues/3651)
## 2.0.2
### :sparkles: Enhancements
@ -30,7 +99,7 @@
### :bug: Bugs fixed
- Fix color palette sorting [Taiga Issue #7458](https://tree.taiga.io/project/penpot/issue/7458)
- Fix color palette sorting [Taiga #7458](https://tree.taiga.io/project/penpot/issue/7458)
- Fix style scoping problem with imported SVG [Taiga #7671](https://tree.taiga.io/project/penpot/issue/7671)
@ -175,7 +244,7 @@
- Fix problem when changing typography assets [Github #3683](https://github.com/penpot/penpot/issues/3683)
- Internal error when you copy and paste some main components between files [Taiga #7397](https://tree.taiga.io/project/penpot/issue/7397)
- Fix toolbar disappearing [Taiga #7411](https://tree.taiga.io/project/penpot/issue/7411)
- Fix long text on tab breaks UI [Taiga Issue #7421](https://tree.taiga.io/project/penpot/issue/7421)
- Fix long text on tab breaks UI [Taiga #7421](https://tree.taiga.io/project/penpot/issue/7421)
## 1.19.5

1
README.md
View file

@ -50,6 +50,7 @@ Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the
- [Why Penpot](#why-penpot)
- [Getting Started](#getting-started)
- [Community](#community)
- [Contributing](#contributing)
- [Resources](#resources)
- [License](#license)

8
THANKYOU.md
View file

@ -2,12 +2,19 @@
We want to thank to the amazing people that help us! Thank you! You're the best!
Feel free you make a PR updating this file if you miss you in the
list.
## Security
* Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
* [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
* Vaibhav Shukla
* Hassan Ahmed (Alias Xen Lee)
* Michal Biesiada (@mbiesiad)
## Internationalization
* [00ff88](https://hosted.weblate.org/user/00ff88)
* [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
* [Aimee](https://hosted.weblate.org/user/Aimee)
@ -89,6 +96,7 @@ We want to thank to the amazing people that help us! Thank you! You're the best!
* [zcraber](https://hosted.weblate.org/user/zcraber)
## Libraries & templates
* systxema
* plumilla
* victor crespo

20
backend/deps.edn
View file

@ -3,10 +3,10 @@
:deps
{penpot/common {:local/root "../common"}
org.clojure/clojure {:mvn/version "1.12.0-alpha9"}
org.clojure/clojure {:mvn/version "1.12.0-alpha12"}
org.clojure/tools.namespace {:mvn/version "1.5.0"}
com.github.luben/zstd-jni {:mvn/version "1.5.5-11"}
com.github.luben/zstd-jni {:mvn/version "1.5.6-3"}
io.prometheus/simpleclient {:mvn/version "0.16.0"}
io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
@ -26,13 +26,13 @@
:git/url "https://github.com/funcool/yetti.git"
:exclusions [org.slf4j/slf4j-api]}
com.github.seancorfield/next.jdbc {:mvn/version "1.3.925"}
metosin/reitit-core {:mvn/version "0.6.0"}
nrepl/nrepl {:mvn/version "1.1.1"}
cider/cider-nrepl {:mvn/version "0.47.1"}
com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
metosin/reitit-core {:mvn/version "0.7.0"}
nrepl/nrepl {:mvn/version "1.1.2"}
cider/cider-nrepl {:mvn/version "0.48.0"}
org.postgresql/postgresql {:mvn/version "42.7.3"}
org.xerial/sqlite-jdbc {:mvn/version "3.45.2.0"}
org.xerial/sqlite-jdbc {:mvn/version "3.46.0.0"}
com.zaxxer/HikariCP {:mvn/version "5.1.0"}
@ -58,7 +58,7 @@
;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
software.amazon.awssdk/s3 {:mvn/version "2.22.12"}
software.amazon.awssdk/s3 {:mvn/version "2.25.63"}
}
:paths ["src" "resources" "target/classes"]
@ -74,13 +74,13 @@
:build
{:extra-deps
{io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
{io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
:ns-default build}
:test
{:main-opts ["-m" "kaocha.runner"]
:jvm-opts ["-Dlog4j2.configurationFile=log4j2-devenv-repl.xml"]
:extra-deps {lambdaisland/kaocha {:mvn/version "1.88.1376"}}}
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
:outdated
{:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}

10
backend/package.json
View file

@ -4,19 +4,19 @@
"license": "MPL-2.0",
"author": "Kaleidos INC",
"private": true,
"packageManager": "yarn@4.2.2",
"packageManager": "yarn@4.3.1",
"repository": {
"type": "git",
"url": "https://github.com/penpot/penpot"
},
"dependencies": {
"luxon": "^3.4.2",
"sax": "^1.2.4"
"luxon": "^3.4.4",
"sax": "^1.4.1"
},
"devDependencies": {
"nodemon": "^3.0.1",
"nodemon": "^3.1.2",
"source-map-support": "^0.5.21",
"ws": "^8.13.0"
"ws": "^8.17.0"
},
"scripts": {
"fmt:clj:check": "cljfmt check --parallel=false src/ test/",

4
backend/resources/app/email/change-email/en.html
View file

@ -168,7 +168,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
</td>
</tr>
<tr>
@ -475,4 +475,4 @@
</div>
</body>
</html>
</html>

2
backend/resources/app/email/change-email/en.txt
View file

@ -1,4 +1,4 @@
Hello {{name}}!
Hello {{name|abbreviate:25}}!
We received a request to change your current email to {{ pending-email }}.

4
backend/resources/app/email/feedback/en.html
View file

@ -11,7 +11,7 @@
{% if profile %}
<span>
<span>Name: </span>
<span><code>{{profile.fullname}}</code></span>
<span><code>{{profile.fullname|abbreviate:25}}</code></span>
</span>
<br />
@ -34,7 +34,7 @@
</p>
<p>
<strong>Subject:</strong><br />
<span>{{subject}}</span>
<span>{{subject|abbreviate:300}}</span>
</p>
<p>

4
backend/resources/app/email/invite-to-team/en.html
View file

@ -173,7 +173,7 @@
</tr>
<tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
<div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">{{invited-by}} has invited you to join the team “{{ team }}”.</div>
<div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.</div>
</td>
</tr>
<tr>
@ -465,4 +465,4 @@
</div>
</body>
</html>
</html>

2
backend/resources/app/email/invite-to-team/en.txt
View file

@ -1,6 +1,6 @@
Hello!
{{invited-by}} has invited you to join the team “{{ team }}”.
{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.
Accept invitation using this link:

4
backend/resources/app/email/password-recovery/en.html
View file

@ -168,7 +168,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
</td>
</tr>
<tr>
@ -470,4 +470,4 @@
</div>
</body>
</html>
</html>

2
backend/resources/app/email/password-recovery/en.txt
View file

@ -1,4 +1,4 @@
Hello {{name}}!
Hello {{name|abbreviate:25}}!
We received a request to reset your password. Click the link below to choose a
new one:

2
backend/resources/app/email/register/en.html
View file

@ -168,7 +168,7 @@
<table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
<div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
</td>
</tr>
<tr>

2
backend/resources/app/email/register/en.txt
View file

@ -1,4 +1,4 @@
Hello {{name}}!
Hello {{name|abbreviate:25}}!
Thanks for signing up for your Penpot account! Please verify your email using the
link below and get started building mockups and prototypes today!

20
backend/resources/app/onboarding.edn
View file

@ -1,4 +1,16 @@
[{:id "tutorial-for-beginners"
[{:id "wireframing-kit"
:name "Wireframe library"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
{:id "prototype-examples"
:name "Prototype template"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/prototype-examples.penpot"}
{:id "plants-app"
:name "UI mockup example"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Plants-app.penpot"}
{:id "penpot-design-system"
:name "Design system example"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Penpot-Design-system.penpot"}
{:id "tutorial-for-beginners"
:name "Tutorial for beginners"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"}
{:id "lucide-icons"
@ -7,12 +19,6 @@
{:id "font-awesome"
:name "Font Awesome"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Font-Awesome.penpot"}
{:id "plants-app"
:name "Plants app"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Plants-app.penpot"}
{:id "wireframing-kit"
:name "Wireframing Kit"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
{:id "black-white-mobile-templates"
:name "Black & White Mobile Templates"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Black-White-Mobile-Templates.penpot"}

7
backend/resources/app/templates/api-doc-entry.tmpl
View file

@ -20,12 +20,19 @@
<span>WEBHOOK</span>
</span>
{% endif %}
{% if item.params-schema-js %}
<span class="tag">
<span>SCHEMA</span>
</span>
{% endif %}
{% if item.spec %}
<span class="tag">
<span>SPEC</span>
</span>
{% endif %}
{% if item.sse %}
<span class="tag">
<span>SSE</span>

1
backend/scripts/repl
View file

@ -24,6 +24,7 @@ export PENPOT_FLAGS="\
enable-rpc-climit \
enable-rpc-rlimit \
enable-soft-rpc-rlimit \
enable-file-snapshot \
enable-webhooks \
enable-access-tokens \
enable-file-validation \

1
backend/scripts/start-dev
View file

@ -17,6 +17,7 @@ export PENPOT_FLAGS="\
disable-secure-session-cookies \
enable-rpc-climit \
enable-smtp \
enable-file-snapshot \
enable-access-tokens \
enable-file-validation \
enable-file-schema-validation";

18
backend/src/app/auth.clj
View file

@ -6,9 +6,7 @@
(ns app.auth
(:require
[app.config :as cf]
[buddy.hashers :as hashers]
[cuerdas.core :as str]))
[buddy.hashers :as hashers]))
(def default-params
{:alg :argon2id
@ -27,17 +25,3 @@
(catch Throwable _
{:update false
:valid false})))
(defn email-domain-in-whitelist?
"Returns true if email's domain is in the given whitelist or if
given whitelist is an empty string."
([email]
(let [domains (cf/get :registration-domain-whitelist)]
(email-domain-in-whitelist? domains email)))
([domains email]
(if (or (nil? domains) (empty? domains))
true
(let [[_ candidate] (-> (str/lower email)
(str/split #"@" 2))]
(contains? domains candidate)))))

24
backend/src/app/auth/ldap.clj
View file

@ -9,7 +9,6 @@
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cf]
[clj-ldap.client :as ldap]
[clojure.spec.alpha :as s]
[clojure.string]
@ -104,17 +103,17 @@
nil))))
(s/def ::enabled? ::us/boolean)
(s/def ::host ::cf/ldap-host)
(s/def ::port ::cf/ldap-port)
(s/def ::ssl ::cf/ldap-ssl)
(s/def ::tls ::cf/ldap-starttls)
(s/def ::query ::cf/ldap-user-query)
(s/def ::base-dn ::cf/ldap-base-dn)
(s/def ::bind-dn ::cf/ldap-bind-dn)
(s/def ::bind-password ::cf/ldap-bind-password)
(s/def ::attrs-email ::cf/ldap-attrs-email)
(s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
(s/def ::attrs-username ::cf/ldap-attrs-username)
(s/def ::host ::us/string)
(s/def ::port ::us/integer)
(s/def ::ssl ::us/boolean)
(s/def ::tls ::us/boolean)
(s/def ::query ::us/string)
(s/def ::base-dn ::us/string)
(s/def ::bind-dn ::us/string)
(s/def ::bind-password ::us/string)
(s/def ::attrs-email ::us/string)
(s/def ::attrs-fullname ::us/string)
(s/def ::attrs-username ::us/string)
(s/def ::provider-params
(s/keys :opt-un [::host ::port
@ -126,6 +125,7 @@
::attrs-email
::attrs-username
::attrs-fullname]))
(s/def ::provider
(s/nilable ::provider-params))

233
backend/src/app/auth/oidc.clj
View file

@ -7,7 +7,6 @@
(ns app.auth.oidc
"OIDC client implementation."
(:require
[app.auth :as auth]
[app.auth.oidc.providers :as-alias providers]
[app.common.data :as d]
[app.common.data.macros :as dm]
@ -17,12 +16,17 @@
[app.common.uri :as u]
[app.config :as cf]
[app.db :as db]
[app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist]
[app.http.client :as http]
[app.http.errors :as errors]
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.rpc :as rpc]
[app.rpc.commands.profile :as profile]
[app.setup :as-alias setup]
[app.tokens :as tokens]
[app.util.inet :as inet]
[app.util.json :as json]
[app.util.time :as dt]
[buddy.sign.jwk :as jwk]
@ -31,6 +35,7 @@
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[ring.request :as rreq]
[ring.response :as-alias rres]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -128,8 +133,8 @@
(-> body json/decode :keys process-oidc-jwks)
(do
(l/warn :hint "unable to retrieve JWKs (unexpected response status code)"
:http-status status
:http-body body)
:response-status status
:response-body body)
nil)))
(catch Throwable cause
(l/warn :hint "unable to retrieve JWKs (unexpected exception)"
@ -143,18 +148,18 @@
(when (contains? cf/flags :login-with-oidc)
(if-let [opts (prepare-oidc-opts cfg)]
(let [jwks (fetch-oidc-jwks cfg opts)]
(l/info :hint "provider initialized"
:provider "oidc"
:method (if (:discover? opts) "discover" "manual")
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts))
:scopes (str/join "," (:scopes opts))
:auth-uri (:auth-uri opts)
:user-uri (:user-uri opts)
:token-uri (:token-uri opts)
:roles-attr (:roles-attr opts)
:roles (:roles opts)
:keys (str/join "," (map str (keys jwks))))
(l/inf :hint "provider initialized"
:provider "oidc"
:method (if (:discover? opts) "discover" "manual")
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts))
:scopes (str/join "," (:scopes opts))
:auth-uri (:auth-uri opts)
:user-uri (:user-uri opts)
:token-uri (:token-uri opts)
:roles-attr (:roles-attr opts)
:roles (:roles opts)
:keys (str/join "," (map str (keys jwks))))
(assoc opts :jwks jwks))
(do
(l/warn :hint "unable to initialize auth provider, missing configuration" :provider "oidc")
@ -178,10 +183,10 @@
(if (and (string? (:client-id opts))
(string? (:client-secret opts)))
(do
(l/info :hint "provider initialized"
:provider "google"
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
(l/inf :hint "provider initialized"
:provider "google"
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
opts)
(do
@ -206,8 +211,9 @@
(ex/raise :type :internal
:code :unable-to-retrieve-github-emails
:hint "unable to retrieve github emails"
:http-status status
:http-body body))
:request-uri (:uri params)
:response-status status
:response-body body))
(->> body json/decode (filter :primary) first :email))))
@ -232,10 +238,10 @@
(if (and (string? (:client-id opts))
(string? (:client-secret opts)))
(do
(l/info :hint "provider initialized"
:provider "github"
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
(l/inf :hint "provider initialized"
:provider "github"
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
opts)
(do
@ -247,7 +253,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/init-key ::providers/gitlab
[_ _]
[_ cfg]
(let [base (cf/get :gitlab-base-uri "https://gitlab.com")
opts {:base-uri base
:client-id (cf/get :gitlab-client-id)
@ -256,17 +262,18 @@
:auth-uri (str base "/oauth/authorize")
:token-uri (str base "/oauth/token")
:user-uri (str base "/oauth/userinfo")
:jwks-uri (str base "/oauth/discovery/keys")
:name "gitlab"}]
(when (contains? cf/flags :login-with-gitlab)
(if (and (string? (:client-id opts))
(string? (:client-secret opts)))
(do
(l/info :hint "provider initialized"
:provider "gitlab"
:base-uri base
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
opts)
(let [jwks (fetch-oidc-jwks cfg opts)]
(l/inf :hint "provider initialized"
:provider "gitlab"
:base-uri base
:client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)))
(assoc opts :jwks jwks))
(do
(l/warn :hint "unable to initialize auth provider, missing configuration" :provider "gitlab")
@ -322,26 +329,31 @@
:uri (:token-uri provider)
:body (u/map->query-string params)}]
(l/trace :hint "request access token"
:provider (:name provider)
:client-id (:client-id provider)
:client-secret (obfuscate-string (:client-secret provider))
:grant-type (:grant_type params)
:redirect-uri (:redirect_uri params))
(l/trc :hint "fetch access token"
:provider (:name provider)
:client-id (:client-id provider)
:client-secret (obfuscate-string (:client-secret provider))
:grant-type (:grant_type params)
:redirect-uri (:redirect_uri params))
(let [{:keys [status body]} (http/req! cfg req {:sync? true})]
(l/trace :hint "access token response" :status status :body body)
(l/trc :hint "access token fetched" :status status :body body)
(if (= status 200)
(let [data (json/decode body)]
{:token/access (get data :access_token)
:token/id (get data :id_token)
:token/type (get data :token_type)})
(let [data (json/decode body)
data {:token/access (get data :access_token)
:token/id (get data :id_token)
:token/type (get data :token_type)}]
(l/trc :hint "access token fetched"
:token-id (:token/id data)
:token-type (:token/type data)
:token (:token/access data))
data)
(ex/raise :type :internal
:code :unable-to-retrieve-token
:hint "unable to retrieve token"
:http-status status
:http-body body)))))
:code :unable-to-fetch-access-token
:hint "unable to fetch access token"
:request-uri (:uri req)
:response-status status
:response-body body)))))
(defn- process-user-info
[provider tdata info]
@ -368,9 +380,9 @@
(defn- fetch-user-info
[{:keys [::provider] :as cfg} tdata]
(l/trace :hint "fetch user info"
:uri (:user-uri provider)
:token (obfuscate-string (:token/access tdata)))
(l/trc :hint "fetch user info"
:uri (:user-uri provider)
:token (obfuscate-string (:token/access tdata)))
(let [params {:uri (:user-uri provider)
:headers {"Authorization" (str (:token/type tdata) " " (:token/access tdata))}
@ -378,9 +390,9 @@
:method :get}
response (http/req! cfg params {:sync? true})]
(l/trace :hint "user info response"
:status (:status response)
:body (:body response))
(l/trc :hint "user info response"
:status (:status response)
:body (:body response))
(when-not (s/int-in-range? 200 300 (:status response))
(ex/raise :type :internal
@ -418,12 +430,6 @@
(defn- get-info
[{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
(when-let [error (get params :error)]
(ex/raise :type :internal
:code :error-on-retrieving-code
:error-id error
:error-desc (get params :error_description)))
(let [state (get params :state)
code (get params :code)
state (tokens/verify props {:token state :iss :oauth})
@ -436,7 +442,7 @@
info (process-user-info provider tdata info)]
(l/trace :hint "user info" :info info)
(l/trc :hint "user info" :info info)
(when-not (s/valid? ::info info)
(l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
@ -469,6 +475,9 @@
(some? (:invitation-token state))
(assoc :invitation-token (:invitation-token state))
(some? (:external-session-id state))
(assoc :external-session-id (:external-session-id state))
;; If state token comes with props, merge them. The state token
;; props can contain pm_ and utm_ prefixed query params.
(map? (:props state))
@ -553,24 +562,32 @@
(redirect-to-register cfg info request))
:else
(let [sxf (session/create-fn cfg (:id profile))
token (or (:invitation-token info)
(tokens/generate (::setup/props cfg)
{:iss :auth
:exp (dt/in-future "15m")
:props (:props info)
:profile-id (:id profile)}))]
(let [sxf (session/create-fn cfg (:id profile))
token (or (:invitation-token info)
(tokens/generate (::setup/props cfg)
{:iss :auth
:exp (dt/in-future "15m")
:props (:props info)
:profile-id (:id profile)}))
props (audit/profile->props profile)
context (d/without-nils {:external-session-id (:external-session-id info)})]
(audit/submit! cfg {::audit/type "command"
(audit/submit! cfg {::audit/type "action"
::audit/name "login-with-oidc"
::audit/profile-id (:id profile)
::audit/ip-addr (audit/parse-client-ip request)
::audit/props (audit/profile->props profile)})
::audit/ip-addr (inet/parse-request request)
::audit/props props
::audit/context context})
(->> (redirect-to-verify-token token)
(sxf request))))
(not (auth/email-domain-in-whitelist? (:email info)))
(and (email.blacklist/enabled? cfg)
(email.blacklist/contains? cfg (:email info)))
(redirect-with-error "email-domain-not-allowed")
(and (email.whitelist/enabled? cfg)
(not (email.whitelist/contains? cfg (:email info))))
(redirect-with-error "email-domain-not-allowed")
:else
@ -579,26 +596,50 @@
(redirect-to-register cfg info request)
(redirect-with-error "registration-disabled")))))
(defn- get-external-session-id
[request]
(let [session-id (rreq/get-header request "x-external-session-id")]
(when (string? session-id)
(if (or (> (count session-id) 256)
(= session-id "null")
(str/blank? session-id))
nil
session-id))))
(defn- auth-handler
[cfg {:keys [params] :as request}]
(let [props (audit/extract-utm-params params)
state (tokens/generate (::setup/props cfg)
{:iss :oauth
:invitation-token (:invitation-token params)
:props props
:exp (dt/in-future "4h")})
uri (build-auth-uri cfg state)]
(let [props (audit/extract-utm-params params)
esid (rpc/get-external-session-id request)
params {:iss :oauth
:invitation-token (:invitation-token params)
:external-session-id esid
:props props
:exp (dt/in-future "4h")}
state (tokens/generate (::setup/props cfg)
(d/without-nils params))
uri (build-auth-uri cfg state)]
{::rres/status 200
::rres/body {:redirect-uri uri}}))
(defn- callback-handler
[cfg request]
[{:keys [::provider] :as cfg} request]
(try
(let [info (get-info cfg request)
profile (get-profile cfg info)]
(process-callback cfg request info profile))
(if-let [error (dm/get-in request [:params :error])]
(redirect-with-error "unable-to-auth" error)
(let [info (get-info cfg request)
profile (get-profile cfg info)]
(process-callback cfg request info profile)))
(catch Throwable cause
(l/err :hint "error on oauth process" :cause cause)
(binding [l/*context* (-> (errors/request->context request)
(assoc :auth/provider (:name provider)))]
(let [edata (ex-data cause)]
(cond
(= :validation (:type edata))
(l/wrn :hint "invalid token received" :cause cause)
:else
(l/err :hint "error on oauth process" :cause cause))))
(redirect-with-error "unable-to-auth" (ex-message cause)))))
(def provider-lookup
@ -614,17 +655,17 @@
:provider provider
:hint "provider not configured"))))))})
(s/def ::client-id ::cf/oidc-client-id)
(s/def ::client-secret ::cf/oidc-client-secret)
(s/def ::base-uri ::cf/oidc-base-uri)
(s/def ::token-uri ::cf/oidc-token-uri)
(s/def ::auth-uri ::cf/oidc-auth-uri)
(s/def ::user-uri ::cf/oidc-user-uri)
(s/def ::scopes ::cf/oidc-scopes)
(s/def ::roles ::cf/oidc-roles)
(s/def ::roles-attr ::cf/oidc-roles-attr)
(s/def ::email-attr ::cf/oidc-email-attr)
(s/def ::name-attr ::cf/oidc-name-attr)
(s/def ::client-id ::us/string)
(s/def ::client-secret ::us/string)
(s/def ::base-uri ::us/string)
(s/def ::token-uri ::us/string)
(s/def ::auth-uri ::us/string)
(s/def ::user-uri ::us/string)
(s/def ::scopes ::us/set-of-strings)
(s/def ::roles ::us/set-of-strings)
(s/def ::roles-attr ::us/string)
(s/def ::email-attr ::us/string)
(s/def ::name-attr ::us/string)
(s/def ::provider
(s/keys :req-un [::client-id

55
backend/src/app/binfile/common.clj
View file

@ -15,6 +15,7 @@
[app.common.files.migrations :as fmg]
[app.common.files.validate :as fval]
[app.common.logging :as l]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -331,54 +332,12 @@
(defn embed-assets
[cfg data file-id]
(letfn [(walk-map-form [form state]
(cond
(uuid? (:fill-color-ref-file form))
(do
(vswap! state conj [(:fill-color-ref-file form) :colors (:fill-color-ref-id form)])
(assoc form :fill-color-ref-file file-id))
(uuid? (:stroke-color-ref-file form))
(do
(vswap! state conj [(:stroke-color-ref-file form) :colors (:stroke-color-ref-id form)])
(assoc form :stroke-color-ref-file file-id))
(uuid? (:typography-ref-file form))
(do
(vswap! state conj [(:typography-ref-file form) :typographies (:typography-ref-id form)])
(assoc form :typography-ref-file file-id))
(uuid? (:component-file form))
(do
(vswap! state conj [(:component-file form) :components (:component-id form)])
(assoc form :component-file file-id))
:else
form))
(process-group-of-assets [data [lib-id items]]
;; NOTE: there is a possibility that shape refers to an
;; non-existant file because the file was removed. In this
;; case we just ignore the asset.
(if-let [lib (get-file cfg lib-id)]
(reduce (partial process-asset lib) data items)
data))
(process-asset [lib data [bucket asset-id]]
(let [asset (get-in lib [:data bucket asset-id])
;; Add a special case for colors that need to have
;; correctly set the :file-id prop (pending of the
;; refactor that will remove it).
asset (cond-> asset
(= bucket :colors) (assoc :file-id file-id))]
(update data bucket assoc asset-id asset)))]
(let [assets (volatile! [])]
(walk/postwalk #(cond-> % (map? %) (walk-map-form assets)) data)
(->> (deref assets)
(filter #(as-> (first %) $ (and (uuid? $) (not= $ file-id))))
(d/group-by first rest)
(reduce (partial process-group-of-assets) data)))))
(let [library-ids (get-libraries cfg [file-id])]
(reduce (fn [data library-id]
(let [library (get-file cfg library-id)]
(ctf/absorb-assets data (:data library))))
data
library-ids)))
(defn- fix-version
[file]

1
backend/src/app/binfile/v1.clj
View file

@ -130,7 +130,6 @@
(.writeLong output (long data))
(swap! *position* + 8))
(defn read-long!
[^DataInputStream input]
(let [v (.readLong input)]

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

@ -11,30 +11,17 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.flags :as flags]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.version :as v]
[app.util.overrides]
[app.util.time :as dt]
[clojure.core :as c]
[clojure.java.io :as io]
[clojure.pprint :as pprint]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[environ.core :refer [env]]
[integrant.core :as ig]))
(prefer-method print-method
clojure.lang.IRecord
clojure.lang.IDeref)
(prefer-method print-method
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(prefer-method pprint/simple-dispatch
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(defmethod ig/init-key :default
[_ data]
(d/without-nils data))
@ -45,18 +32,19 @@
(d/without-nils data)
data))
(def defaults
(def default
{:database-uri "postgresql://postgres/penpot"
:database-username "penpot"
:database-password "penpot"
:default-blob-version 5
:default-blob-version 4
:rpc-rlimit-config (fs/path "resources/rlimit.edn")
:rpc-climit-config (fs/path "resources/climit.edn")
:rpc-rlimit-config "resources/rlimit.edn"
:rpc-climit-config "resources/climit.edn"
:file-change-snapshot-every 5
:file-change-snapshot-timeout "3h"
:file-snapshot-total 10
:file-snapshot-every 5
:file-snapshot-timeout "3h"
:public-uri "http://localhost:3449"
:host "localhost"
@ -87,249 +75,148 @@
:ldap-attrs-fullname "cn"
;; a server prop key where initial project is stored.
:initial-project-skey "initial-project"})
:initial-project-skey "initial-project"
(s/def ::default-rpc-rlimit ::us/vector-of-strings)
(s/def ::rpc-rlimit-config ::fs/path)
(s/def ::rpc-climit-config ::fs/path)
;; time to avoid email sending after profile modification
:email-verify-threshold "15m"})
(s/def ::media-max-file-size ::us/integer)
(def schema:config
(do #_sm/optional-keys
[:map {:title "config"}
[:flags {:optional true} [::sm/set :string]]
[:admins {:optional true} [::sm/set ::sm/email]]
[:secret-key {:optional true} :string]
(s/def ::flags ::us/vector-of-keywords)
(s/def ::telemetry-enabled ::us/boolean)
[:tenant {:optional false} :string]
[:public-uri {:optional false} :string]
[:host {:optional false} :string]
(s/def ::audit-log-archive-uri ::us/string)
(s/def ::audit-log-http-handler-concurrency ::us/integer)
[:http-server-port {:optional true} :int]
[:http-server-host {:optional true} :string]
[:http-server-max-body-size {:optional true} :int]
[:http-server-max-multipart-body-size {:optional true} :int]
[:http-server-io-threads {:optional true} :int]
[:http-server-worker-threads {:optional true} :int]
(s/def ::deletion-delay ::dt/duration)
[:telemetry-uri {:optional true} :string]
[:telemetry-with-taiga {:optional true} :boolean] ;; DELETE
(s/def ::admins ::us/set-of-valid-emails)
(s/def ::file-change-snapshot-every ::us/integer)
(s/def ::file-change-snapshot-timeout ::dt/duration)
[:file-snapshot-total {:optional true} :int]
[:file-snapshot-every {:optional true} :int]
[:file-snapshot-timeout {:optional true} ::dt/duration]
(s/def ::default-executor-parallelism ::us/integer)
(s/def ::scheduled-executor-parallelism ::us/integer)
[:media-max-file-size {:optional true} :int]
[:deletion-delay {:optional true} ::dt/duration] ;; REVIEW
[:telemetry-enabled {:optional true} :boolean]
[:default-blob-version {:optional true} :int]
[:allow-demo-users {:optional true} :boolean]
[:error-report-webhook {:optional true} :string]
[:user-feedback-destination {:optional true} :string]
(s/def ::worker-default-parallelism ::us/integer)
(s/def ::worker-webhook-parallelism ::us/integer)
[:default-rpc-rlimit {:optional true} [::sm/vec :string]]
[:rpc-rlimit-config {:optional true} ::fs/path]
[:rpc-climit-config {:optional true} ::fs/path]
(s/def ::auth-data-cookie-domain ::us/string)
(s/def ::auth-token-cookie-name ::us/string)
(s/def ::auth-token-cookie-max-age ::dt/duration)
[:audit-log-archive-uri {:optional true} :string]
[:audit-log-http-handler-concurrency {:optional true} :int]
(s/def ::secret-key ::us/string)
(s/def ::allow-demo-users ::us/boolean)
(s/def ::assets-path ::us/string)
(s/def ::database-password (s/nilable ::us/string))
(s/def ::database-uri ::us/string)
(s/def ::database-username (s/nilable ::us/string))
(s/def ::database-readonly ::us/boolean)
(s/def ::database-min-pool-size ::us/integer)
(s/def ::database-max-pool-size ::us/integer)
[:default-executor-parallelism {:optional true} :int] ;; REVIEW
[:scheduled-executor-parallelism {:optional true} :int] ;; REVIEW
[:worker-default-parallelism {:optional true} :int]
[:worker-webhook-parallelism {:optional true} :int]
(s/def ::quotes-teams-per-profile ::us/integer)
(s/def ::quotes-access-tokens-per-profile ::us/integer)
(s/def ::quotes-projects-per-team ::us/integer)
(s/def ::quotes-invitations-per-team ::us/integer)
(s/def ::quotes-profiles-per-team ::us/integer)
(s/def ::quotes-files-per-project ::us/integer)
(s/def ::quotes-files-per-team ::us/integer)
(s/def ::quotes-font-variants-per-team ::us/integer)
(s/def ::quotes-comment-threads-per-file ::us/integer)
(s/def ::quotes-comments-per-file ::us/integer)
[:database-password {:optional true} [:maybe :string]]
[:database-uri {:optional true} :string]
[:database-username {:optional true} [:maybe :string]]
[:database-readonly {:optional true} :boolean]
[:database-min-pool-size {:optional true} :int]
[:database-max-pool-size {:optional true} :int]
(s/def ::default-blob-version ::us/integer)
(s/def ::error-report-webhook ::us/string)
(s/def ::user-feedback-destination ::us/string)
(s/def ::github-client-id ::us/string)
(s/def ::github-client-secret ::us/string)
(s/def ::gitlab-base-uri ::us/string)
(s/def ::gitlab-client-id ::us/string)
(s/def ::gitlab-client-secret ::us/string)
(s/def ::google-client-id ::us/string)
(s/def ::google-client-secret ::us/string)
(s/def ::oidc-client-id ::us/string)
(s/def ::oidc-user-info-source ::us/keyword)
(s/def ::oidc-client-secret ::us/string)
(s/def ::oidc-base-uri ::us/string)
(s/def ::oidc-token-uri ::us/string)
(s/def ::oidc-auth-uri ::us/string)
(s/def ::oidc-user-uri ::us/string)
(s/def ::oidc-jwks-uri ::us/string)
(s/def ::oidc-scopes ::us/set-of-strings)
(s/def ::oidc-roles ::us/set-of-strings)
(s/def ::oidc-roles-attr ::us/string)
(s/def ::oidc-email-attr ::us/string)
(s/def ::oidc-name-attr ::us/string)
(s/def ::host ::us/string)
(s/def ::http-server-port ::us/integer)
(s/def ::http-server-host ::us/string)
(s/def ::http-server-max-body-size ::us/integer)
(s/def ::http-server-max-multipart-body-size ::us/integer)
(s/def ::http-server-io-threads ::us/integer)
(s/def ::http-server-worker-threads ::us/integer)
(s/def ::ldap-attrs-email ::us/string)
(s/def ::ldap-attrs-fullname ::us/string)
(s/def ::ldap-attrs-username ::us/string)
(s/def ::ldap-base-dn ::us/string)
(s/def ::ldap-bind-dn ::us/string)
(s/def ::ldap-bind-password ::us/string)
(s/def ::ldap-host ::us/string)
(s/def ::ldap-port ::us/integer)
(s/def ::ldap-ssl ::us/boolean)
(s/def ::ldap-starttls ::us/boolean)
(s/def ::ldap-user-query ::us/string)
(s/def ::media-directory ::us/string)
(s/def ::media-uri ::us/string)
(s/def ::profile-bounce-max-age ::dt/duration)
(s/def ::profile-bounce-threshold ::us/integer)
(s/def ::profile-complaint-max-age ::dt/duration)
(s/def ::profile-complaint-threshold ::us/integer)
(s/def ::public-uri ::us/string)
(s/def ::redis-uri ::us/string)
(s/def ::registration-domain-whitelist ::us/set-of-strings)
[:quotes-teams-per-profile {:optional true} :int]
[:quotes-access-tokens-per-profile {:optional true} :int]
[:quotes-projects-per-team {:optional true} :int]
[:quotes-invitations-per-team {:optional true} :int]
[:quotes-profiles-per-team {:optional true} :int]
[:quotes-files-per-project {:optional true} :int]
[:quotes-files-per-team {:optional true} :int]
[:quotes-font-variants-per-team {:optional true} :int]
[:quotes-comment-threads-per-file {:optional true} :int]
[:quotes-comments-per-file {:optional true} :int]
(s/def ::smtp-default-from ::us/string)
(s/def ::smtp-default-reply-to ::us/string)
(s/def ::smtp-host ::us/string)
(s/def ::smtp-password (s/nilable ::us/string))
(s/def ::smtp-port ::us/integer)
(s/def ::smtp-ssl ::us/boolean)
(s/def ::smtp-tls ::us/boolean)
(s/def ::smtp-username (s/nilable ::us/string))
(s/def ::urepl-host ::us/string)
(s/def ::urepl-port ::us/integer)
(s/def ::prepl-host ::us/string)
(s/def ::prepl-port ::us/integer)
(s/def ::assets-storage-backend ::us/keyword)
(s/def ::storage-assets-fs-directory ::us/string)
(s/def ::storage-assets-s3-bucket ::us/string)
(s/def ::storage-assets-s3-region ::us/keyword)
(s/def ::storage-assets-s3-endpoint ::us/string)
(s/def ::storage-assets-s3-io-threads ::us/integer)
(s/def ::telemetry-uri ::us/string)
(s/def ::telemetry-with-taiga ::us/boolean)
(s/def ::tenant ::us/string)
[:auth-data-cookie-domain {:optional true} :string]
[:auth-token-cookie-name {:optional true} :string]
[:auth-token-cookie-max-age {:optional true} ::dt/duration]
(s/def ::config
(s/keys :opt-un [::secret-key
::flags
::admins
::deletion-delay
::allow-demo-users
::audit-log-archive-uri
::audit-log-http-handler-concurrency
::auth-token-cookie-name
::auth-token-cookie-max-age
::authenticated-cookie-domain
::database-password
::database-uri
::database-username
::database-readonly
::database-min-pool-size
::database-max-pool-size
::default-blob-version
::default-rpc-rlimit
::error-report-webhook
::default-executor-parallelism
::scheduled-executor-parallelism
::worker-default-parallelism
::worker-webhook-parallelism
::file-change-snapshot-every
::file-change-snapshot-timeout
::user-feedback-destination
::github-client-id
::github-client-secret
::gitlab-base-uri
::gitlab-client-id
::gitlab-client-secret
::google-client-id
::google-client-secret
::oidc-client-id
::oidc-client-secret
::oidc-user-info-source
::oidc-base-uri
::oidc-token-uri
::oidc-auth-uri
::oidc-user-uri
::oidc-jwks-uri
::oidc-scopes
::oidc-roles-attr
::oidc-email-attr
::oidc-name-attr
::oidc-roles
::host
::http-server-host
::http-server-port
::http-server-max-body-size
::http-server-max-multipart-body-size
::http-server-io-threads
::http-server-worker-threads
::ldap-attrs-email
::ldap-attrs-fullname
::ldap-attrs-username
::ldap-base-dn
::ldap-bind-dn
::ldap-bind-password
::ldap-host
::ldap-port
::ldap-ssl
::ldap-starttls
::ldap-user-query
::local-assets-uri
::media-max-file-size
::profile-bounce-max-age
::profile-bounce-threshold
::profile-complaint-max-age
::profile-complaint-threshold
::public-uri
[:registration-domain-whitelist {:optional true} [::sm/set :string]]
[:email-verify-threshold {:optional true} ::dt/duration]
::quotes-teams-per-profile
::quotes-access-tokens-per-profile
::quotes-projects-per-team
::quotes-invitations-per-team
::quotes-profiles-per-team
::quotes-files-per-project
::quotes-files-per-team
::quotes-font-variants-per-team
::quotes-comment-threads-per-file
::quotes-comments-per-file
[:github-client-id {:optional true} :string]
[:github-client-secret {:optional true} :string]
[:gitlab-base-uri {:optional true} :string]
[:gitlab-client-id {:optional true} :string]
[:gitlab-client-secret {:optional true} :string]
[:google-client-id {:optional true} :string]
[:google-client-secret {:optional true} :string]
[:oidc-client-id {:optional true} :string]
[:oidc-user-info-source {:optional true} :keyword]
[:oidc-client-secret {:optional true} :string]
[:oidc-base-uri {:optional true} :string]
[:oidc-token-uri {:optional true} :string]
[:oidc-auth-uri {:optional true} :string]
[:oidc-user-uri {:optional true} :string]
[:oidc-jwks-uri {:optional true} :string]
[:oidc-scopes {:optional true} [::sm/set :string]]
[:oidc-roles {:optional true} [::sm/set :string]]
[:oidc-roles-attr {:optional true} :string]
[:oidc-email-attr {:optional true} :string]
[:oidc-name-attr {:optional true} :string]
::redis-uri
::registration-domain-whitelist
::rpc-rlimit-config
::rpc-climit-config
[:ldap-attrs-email {:optional true} :string]
[:ldap-attrs-fullname {:optional true} :string]
[:ldap-attrs-username {:optional true} :string]
[:ldap-base-dn {:optional true} :string]
[:ldap-bind-dn {:optional true} :string]
[:ldap-bind-password {:optional true} :string]
[:ldap-host {:optional true} :string]
[:ldap-port {:optional true} :int]
[:ldap-ssl {:optional true} :boolean]
[:ldap-starttls {:optional true} :boolean]
[:ldap-user-query {:optional true} :string]
::semaphore-process-font
::semaphore-process-image
::semaphore-update-file
::semaphore-auth
[:profile-bounce-max-age {:optional true} ::dt/duration]
[:profile-bounce-threshold {:optional true} :int]
[:profile-complaint-max-age {:optional true} ::dt/duration]
[:profile-complaint-threshold {:optional true} :int]
::smtp-default-from
::smtp-default-reply-to
::smtp-host
::smtp-password
::smtp-port
::smtp-ssl
::smtp-tls
::smtp-username
[:redis-uri {:optional true} :string]
::urepl-host
::urepl-port
::prepl-host
::prepl-port
[:email-domain-blacklist {:optional true} ::fs/path]
[:email-domain-whitelist {:optional true} ::fs/path]
::assets-storage-backend
::storage-assets-fs-directory
::storage-assets-s3-bucket
::storage-assets-s3-region
::storage-assets-s3-endpoint
::storage-assets-s3-io-threads
::telemetry-enabled
::telemetry-uri
::telemetry-referer
::telemetry-with-taiga
::tenant]))
[:smtp-default-from {:optional true} :string]
[:smtp-default-reply-to {:optional true} :string]
[:smtp-host {:optional true} :string]
[:smtp-password {:optional true} [:maybe :string]]
[:smtp-port {:optional true} :int]
[:smtp-ssl {:optional true} :boolean]
[:smtp-tls {:optional true} :boolean]
[:smtp-username {:optional true} [:maybe :string]]
[:urepl-host {:optional true} :string]
[:urepl-port {:optional true} :int]
[:prepl-host {:optional true} :string]
[:prepl-port {:optional true} :int]
[:assets-storage-backend {:optional true} :keyword]
[:media-directory {:optional true} :string] ;; REVIEW
[:media-uri {:optional true} :string]
[:assets-path {:optional true} :string]
[:storage-assets-fs-directory {:optional true} :string]
[:storage-assets-s3-bucket {:optional true} :string]
[:storage-assets-s3-region {:optional true} :keyword]
[:storage-assets-s3-endpoint {:optional true} :string]
[:storage-assets-s3-io-threads {:optional true} :int]]))
(def default-flags
[:enable-backend-api-doc
@ -357,20 +244,22 @@
{}
env)))
(defn- read-config
[]
(try
(->> (read-env "penpot")
(merge defaults)
(us/conform ::config))
(catch Throwable e
(when (ex/error? e)
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
(println "Error on validating configuration:")
(println (some-> e ex-data ex/explain))
(println (ex/explain (ex-data e)))
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"))
(throw e))))
(def decode-config
(sm/decoder schema:config sm/default-transformer))
(def validate-config
(sm/validator schema:config))
(def explain-config
(sm/explainer schema:config))
(defn read-config
"Reads the configuration from enviroment variables and decodes all
known values."
[& {:keys [prefix default] :or {prefix "penpot"}}]
(->> (read-env prefix)
(merge default)
(decode-config)))
(def version
(v/parse (or (some-> (io/resource "version.txt")
@ -378,10 +267,28 @@
(str/trim))
"%version%")))
(defonce ^:dynamic config (read-config))
(defonce ^:dynamic config (read-config :default default))
(defonce ^:dynamic flags (parse-flags config))
(def deletion-delay
(defn validate!
"Validate the currently loaded configuration data."
[& {:keys [exit-on-error?] :or {exit-on-error? true}}]
(if (validate-config config)
true
(let [explain (explain-config config)]
(println "Error on validating configuration:")
(sm/pretty-explain explain
:variant ::sm/schemaless-explain
:message "Configuration Validation Error")
(flush)
(if exit-on-error?
(System/exit -1)
(ex/raise :type :validation
:code :config-validaton
::sm/explain explain)))))
(defn get-deletion-delay
[]
(or (c/get config :deletion-delay)
(dt/duration {:days 7})))

63
backend/src/app/email.clj
View file

@ -7,9 +7,11 @@
(ns app.email
"Main api for send emails."
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
@ -149,9 +151,27 @@
"mail.smtp.timeout" timeout
"mail.smtp.connectiontimeout" timeout}))
(def ^:private schema:smtp-config
[:map
[::username {:optional true} :string]
[::password {:optional true} :string]
[::tls {:optional true} :boolean]
[::ssl {:optional true} :boolean]
[::host {:optional true} :string]
[::port {:optional true} :int]
[::default-from {:optional true} :string]
[::default-reply-to {:optional true} :string]])
(def valid-smtp-config?
(sm/check-fn schema:smtp-config))
(defn- create-smtp-session
^Session
[cfg]
(dm/assert!
"expected valid smtp config"
(valid-smtp-config? cfg))
(let [props (opts->props cfg)]
(Session/getInstance props)))
@ -262,44 +282,21 @@
(let [email (if factory
(factory context)
(dissoc context ::conn))]
(wrk/submit! (merge
{::wrk/task :sendmail
::wrk/delay 0
::wrk/max-retries 4
::wrk/priority 200
::wrk/conn conn}
email))))
(wrk/submit! {::wrk/task :sendmail
::wrk/delay 0
::wrk/max-retries 4
::wrk/priority 200
::db/conn conn
::wrk/params email})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SENDMAIL FN / TASK HANDLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::username ::cf/smtp-username)
(s/def ::password ::cf/smtp-password)
(s/def ::tls ::cf/smtp-tls)
(s/def ::ssl ::cf/smtp-ssl)
(s/def ::host ::cf/smtp-host)
(s/def ::port ::cf/smtp-port)
(s/def ::default-reply-to ::cf/smtp-default-reply-to)
(s/def ::default-from ::cf/smtp-default-from)
(s/def ::smtp-config
(s/keys :opt [::username
::password
::tls
::ssl
::host
::port
::default-from
::default-reply-to]))
(declare send-to-logger!)
(s/def ::sendmail fn?)
(defmethod ig/pre-init-spec ::sendmail [_]
(s/spec ::smtp-config))
(defmethod ig/init-key ::sendmail
[_ cfg]
(fn [params]
@ -449,3 +446,11 @@
{:email email :type "bounce"}
{:limit 10}))]
(>= (count reports) threshold))))
(defn has-reports?
([conn email] (has-reports? conn email nil))
([conn email {:keys [threshold] :or {threshold 1}}]
(let [reports (db/exec! conn (sql/select :global-complaint-report
{:email email}
{:limit 10}))]
(>= (count reports) threshold))))

47
backend/src/app/email/blacklist.clj Normal file
View file

@ -0,0 +1,47 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.email.blacklist
"Email blacklist provider"
(:refer-clojure :exclude [contains?])
(:require
[app.common.logging :as l]
[app.config :as cf]
[app.email :as-alias email]
[clojure.core :as c]
[clojure.java.io :as io]
[cuerdas.core :as str]
[integrant.core :as ig]))
(defmethod ig/init-key ::email/blacklist
[_ _]
(when (c/contains? cf/flags :email-blacklist)
(try
(let [path (cf/get :email-domain-blacklist)
result (with-open [reader (io/reader path)]
(reduce (fn [result line]
(if (str/starts-with? line "#")
result
(conj result (-> line str/trim str/lower))))
#{}
(line-seq reader)))]
(l/inf :hint "initializing email blacklist" :domains (count result))
(not-empty result))
(catch Throwable cause
(l/wrn :hint "unexpected exception on initializing email blacklist"
:cause cause)))))
(defn contains?
"Check if email is in the blacklist."
[{:keys [::email/blacklist]} email]
(let [[_ domain] (str/split email "@" 2)]
(c/contains? blacklist (str/lower domain))))
(defn enabled?
"Check if the blacklist is enabled"
[{:keys [::email/blacklist]}]
(some? blacklist))

59
backend/src/app/email/whitelist.clj Normal file
View file

@ -0,0 +1,59 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.email.whitelist
"Email whitelist provider"
(:refer-clojure :exclude [contains?])
(:require
[app.common.logging :as l]
[app.config :as cf]
[app.email :as-alias email]
[clojure.core :as c]
[clojure.java.io :as io]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[integrant.core :as ig]))
(defn- read-whitelist
[path]
(when (and path (fs/exists? path))
(try
(with-open [reader (io/reader path)]
(reduce (fn [result line]
(if (str/starts-with? line "#")
result
(conj result (-> line str/trim str/lower))))
#{}
(line-seq reader)))
(catch Throwable cause
(l/wrn :hint "unexpected exception on reading email whitelist"
:cause cause)))))
(defmethod ig/init-key ::email/whitelist
[_ _]
(let [whitelist (or (cf/get :registration-domain-whitelist) #{})
whitelist (if (c/contains? cf/flags :email-whitelist)
(into whitelist (read-whitelist (cf/get :email-domain-whitelist)))
whitelist)
whitelist (not-empty whitelist)]
(when whitelist
(l/inf :hint "initializing email whitelist" :domains (count whitelist)))
whitelist))
(defn contains?
"Check if email is in the whitelist."
[{:keys [::email/whitelist]} email]
(let [[_ domain] (str/split email "@" 2)]
(c/contains? whitelist (str/lower domain))))
(defn enabled?
"Check if the whitelist is enabled"
[{:keys [::email/whitelist]}]
(some? whitelist))

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

@ -114,7 +114,7 @@
(partial not-found-handler request)))
(on-error [cause request]
(let [{:keys [body] :as response} (errors/handle cause request)]
(let [{:keys [::rres/body] :as response} (errors/handle cause request)]
(cond-> response
(map? body)
(-> (update ::rres/headers assoc "content-type" "application/transit+json")
@ -151,9 +151,9 @@
[mw/params]
[mw/format-response]
[mw/parse-request]
[mw/errors errors/handle]
[session/soft-auth cfg]
[actoken/soft-auth cfg]
[mw/errors errors/handle]
[mw/restrict-methods]]}
(::mtx/routes cfg)

132
backend/src/app/http/awsns.clj
View file

@ -9,6 +9,7 @@
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pprint :as pp]
[app.db :as db]
[app.db.sql :as sql]
[app.http.client :as http]
@ -16,10 +17,10 @@
[app.setup :as-alias setup]
[app.tokens :as tokens]
[app.worker :as-alias wrk]
[clojure.data.json :as j]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[jsonista.core :as j]
[promesa.exec :as px]
[ring.request :as rreq]
[ring.response :as-alias rres]))
@ -136,83 +137,110 @@
(defn- parse-json
[v]
(ex/ignoring
(j/read-value v)))
(try
(j/read-str v)
(catch Throwable cause
(l/wrn :hint "unable to decode request body"
:cause cause))))
(defn- register-bounce-for-profile
[{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
(when (= kind "permanent")
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
(try
(db/insert! pool :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by mail and if exists
;; register profile reports for them?
(doseq [recipient (:recipients report)]
(db/insert! conn :global-complaint-report
{:email (:email recipient)
:type (name type)
:content (db/tjson report)}))
(catch Throwable cause
(l/warn :hint "unable to persist profile complaint"
:cause cause)))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, can be caused when a user
;; registers with an invalid email or the user email is
;; permanently rejecting receiving the email. In this case we
;; have no option to mark the user as muted (and in this case
;; the profile will be also inactive.
(db/update! conn :profile
{:is-muted true}
{:id profile-id}))))))
(defn- register-complaint-for-profile
[{:keys [::db/pool]} {:keys [type profile-id] :as report}]
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by email and if exists
;; register profile reports for them?
(doseq [email (:recipients report)]
(db/insert! conn :global-complaint-report
{:email email
(doseq [recipient (:recipients report)]
(db/insert! pool :global-complaint-report
{:email (:email recipient)
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report))
(let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
(when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this
;; case just mark profile as muted (very rare case).
(db/update! conn :profile
;; the report is for itself, can be caused when a user
;; registers with an invalid email or the user email is
;; permanently rejecting receiving the email. In this case we
;; have no option to mark the user as muted (and in this case
;; the profile will be also inactive.
(l/inf :hint "mark profile: muted"
:profile-id (str (:id profile))
:email (:email profile)
:reason "bounce report"
:report-id (:feedback-id report))
(db/update! pool :profile
{:is-muted true}
{:id profile-id})))))
{:id profile-id}
{::db/return-keys false})))))
(defn- register-complaint-for-profile
[{:keys [::db/pool]} {:keys [type profile-id] :as report}]
(try
(db/insert! pool :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
(catch Throwable cause
(l/warn :hint "unable to persist profile complaint"
:cause cause)))
;; TODO: maybe also try to find profiles by email and if exists
;; register profile reports for them?
(doseq [email (:recipients report)]
(db/insert! pool :global-complaint-report
{:email email
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this
;; case just mark profile as muted (very rare case).
(l/inf :hint "mark profile: muted"
:profile-id (str (:id profile))
:email (:email profile)
:reason "complaint report"
:report-id (:feedback-id report))
(db/update! pool :profile
{:is-muted true}
{:id profile-id}
{::db/return-keys false}))))
(defn- process-report
[cfg {:keys [type profile-id] :as report}]
(l/trace :action "processing report" :report (pr-str report))
(cond
;; In this case we receive a bounce/complaint notification without
;; confirmed identity, we just emit a warning but do nothing about
;; it because this is not a normal case. All notifications should
;; come with profile identity.
(nil? profile-id)
(l/warn :msg "a notification without identity received from AWS"
:report (pr-str report))
(l/wrn :hint "not-identified report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(= "bounce" type)
(register-bounce-for-profile cfg report)
(do
(l/trc :hint "bounce report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(register-bounce-for-profile cfg report))
(= "complaint" type)
(register-complaint-for-profile cfg report)
(do
(l/trc :hint "complaint report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(register-complaint-for-profile cfg report))
:else
(l/warn :msg "unrecognized report received from AWS"
:report (pr-str report))))
(l/wrn :hint "unrecognized report"
::l/body (pp/pprint-str report {:length 20 :level 4}))))

7
backend/src/app/http/client.clj
View file

@ -54,9 +54,10 @@
"A convencience toplevel function for gradual migration to a new API
convention."
([cfg-or-client request]
(let [client (resolve-client cfg-or-client)]
(let [client (resolve-client cfg-or-client)
request (update request :uri str)]
(send! client request {:sync? true})))
([cfg-or-client request options]
(let [client (resolve-client cfg-or-client)]
(let [client (resolve-client cfg-or-client)
request (update request :uri str)]
(send! client request (merge {:sync? true} options)))))

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

@ -14,32 +14,28 @@
[app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.http.session :as-alias session]
[app.util.inet :as inet]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[ring.request :as rreq]
[ring.response :as rres]))
(defn- parse-client-ip
[request]
(or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip")
(rreq/remote-addr request)))
(defn request->context
"Extracts error report relevant context data from request."
[request]
(let [claims (-> {}
(into (::session/token-claims request))
(into (::actoken/token-claims request)))]
{:request/path (:path request)
:request/method (:method request)
:request/params (:params request)
:request/user-agent (rreq/get-header request "user-agent")
:request/ip-addr (parse-client-ip request)
:request/ip-addr (inet/parse-request request)
:request/profile-id (:uid claims)
:version/frontend (or (rreq/get-header request "x-frontend-version") "unknown")
:version/backend (:full cf/version)}))
(defmulti handle-error
(fn [cause _ _]
(-> cause ex-data :type)))

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

@ -10,16 +10,14 @@
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.util.json :as json]
[app.http.errors :as errors]
[clojure.data.json :as json]
[cuerdas.core :as str]
[ring.request :as rreq]
[ring.response :as rres]
[yetti.adapter :as yt]
[yetti.middleware :as ymw])
(:import
com.fasterxml.jackson.core.JsonParseException
com.fasterxml.jackson.core.io.JsonEOFException
com.fasterxml.jackson.databind.exc.MismatchedInputException
io.undertow.server.RequestTooBigException
java.io.InputStream
java.io.OutputStream))
@ -34,11 +32,22 @@
{:name ::params
:compile (constantly ymw/wrap-params)})
(def ^:private json-mapper
(json/mapper
{:encode-key-fn str/camel
:decode-key-fn (comp keyword str/kebab)
:pretty true}))
(defn- get-reader
^java.io.BufferedReader
[request]
(let [^InputStream body (rreq/body request)]
(java.io.BufferedReader.
(java.io.InputStreamReader. body))))
(defn- read-json-key
[k]
(-> k str/kebab keyword))
(defn- write-json-key
[k]
(if (or (keyword? k) (symbol? k))
(str/camel k)
(str k)))
(defn wrap-parse-request
[handler]
@ -53,8 +62,8 @@
(update :params merge params))))
(str/starts-with? header "application/json")
(with-open [^InputStream is (rreq/body request)]
(let [params (json/decode is json-mapper)]
(with-open [reader (get-reader request)]
(let [params (json/read reader :key-fn read-json-key)]
(-> request
(assoc :body-params params)
(update :params merge params))))
@ -62,35 +71,33 @@
:else
request)))
(handle-error [cause]
(handle-error [cause request]
(cond
(instance? RuntimeException cause)
(if-let [cause (ex-cause cause)]
(handle-error cause)
(throw cause))
(handle-error cause request)
(errors/handle cause request))
(instance? RequestTooBigException cause)
(ex/raise :type :validation
:code :request-body-too-large
:hint (ex-message cause))
(or (instance? JsonEOFException cause)
(instance? JsonParseException cause)
(instance? MismatchedInputException cause))
(instance? java.io.EOFException cause)
(ex/raise :type :validation
:code :malformed-json
:hint (ex-message cause)
:cause cause)
:else
(throw cause)))]
(errors/handle cause request)))]
(fn [request]
(if (= (rreq/method request) :post)
(let [request (ex/try! (process-request request))]
(if (ex/exception? request)
(handle-error request)
(handler request)))
(try
(-> request process-request handler)
(catch Throwable cause
(handle-error cause request)))
(handler request)))))
(def parse-request
@ -128,7 +135,8 @@
(-write-body-to-stream [_ _ output-stream]
(try
(with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
(json/write! bos data json-mapper))
(with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
(json/write data writer :key-fn write-json-key)))
(catch java.io.IOException _)
(catch Throwable cause

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

@ -61,6 +61,8 @@
(let [result (handler)]
(events/tap :end result))
(catch Throwable cause
(l/err :hint "unexpected error on processing sse response"
:cause cause)
(events/tap :error (errors/handle' cause request)))
(finally
(sp/close! events/*channel*)

130
backend/src/app/loggers/audit.clj
View file

@ -21,24 +21,18 @@
[app.rpc :as-alias rpc]
[app.rpc.retry :as rtry]
[app.setup :as-alias setup]
[app.util.inet :as inet]
[app.util.services :as-alias sv]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[ring.request :as rreq]))
[integrant.core :as ig]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn parse-client-ip
[request]
(or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip")
(some-> (rreq/remote-addr request) str)))
(defn extract-utm-params
"Extracts additional data from params and namespace them under
`penpot` ns."
@ -86,8 +80,19 @@
(remove #(contains? reserved-props (key %))))
props))
;; --- SPECS
(defn event-from-rpc-params
"Create a base event skeleton with pre-filled some important
data that can be extracted from RPC params object"
[params]
(let [context {:external-session-id (::rpc/external-session-id params)
:external-event-origin (::rpc/external-event-origin params)
:triggered-by (::rpc/handler-name params)}]
{::type "action"
::profile-id (::rpc/profile-id params)
::ip-addr (::rpc/ip-addr params)
::context (d/without-nils context)}))
;; --- SPECS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COLLECTOR
@ -140,25 +145,31 @@
(::rpc/profile-id params)
uuid/zero)
props (-> (or (::replace-props resultm)
(-> params
(merge (::props resultm))
(dissoc :profile-id)
(dissoc :type)))
session-id (get params ::rpc/external-session-id)
event-origin (get params ::rpc/external-event-origin)
props (-> (or (::replace-props resultm)
(-> params
(merge (::props resultm))
(dissoc :profile-id)
(dissoc :type)))
(clean-props))
(clean-props))
token-id (::actoken/id request)
context (-> (::context resultm)
(assoc :external-session-id session-id)
(assoc :external-event-origin event-origin)
(assoc :access-token-id (some-> token-id str))
(d/without-nils))]
(d/without-nils))
ip-addr (inet/parse-request request)]
{::type (or (::type resultm)
(::rpc/type cfg))
::name (or (::name resultm)
(::sv/name mdata))
::profile-id profile-id
::ip-addr (some-> request parse-client-ip)
::ip-addr ip-addr
::props props
::context context
@ -180,15 +191,33 @@
(::webhooks/event? resultm)
false)}))
(defn- handle-event!
[cfg event]
(defn- event->params
[event]
(let [params {:id (uuid/next)
:name (::name event)
:type (::type event)
:profile-id (::profile-id event)
:ip-addr (::ip-addr event)
:context (::context event)
:props (::props event)}
:context (::context event {})
:props (::props event {})
:source "backend"}
tnow (::tracked-at event)]
(cond-> params
(some? tnow)
(assoc :tracked-at tnow))))
(defn- append-audit-entry!
[cfg params]
(let [params (-> params
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet))]
(db/insert! cfg :audit-log params)))
(defn- handle-event!
[cfg event]
(let [params (event->params event)
tnow (dt/now)]
(when (contains? cf/flags :audit-log)
@ -197,12 +226,8 @@
;; this case we just retry the operation.
(let [params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow)
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet)
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(update :tracked-at #(or % tnow)))]
(append-audit-entry! cfg params)))
(when (and (or (contains? cf/flags :telemetry)
(cf/get :telemetry-enabled))
@ -214,12 +239,10 @@
;; NOTE: this is only executed when general audit log is disabled
(let [params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow)
(assoc :props (db/tjson {}))
(assoc :context (db/tjson {}))
(assoc :ip-addr (db/inet "0.0.0.0"))
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(update :tracked-at #(or % tnow))
(assoc :props {})
(assoc :context {}))]
(append-audit-entry! cfg params)))
(when (and (contains? cf/flags :webhooks)
(::webhooks/event? event))
@ -232,25 +255,23 @@
:else label)
dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! ::wrk/conn (::db/conn cfg)
::wrk/task :process-webhook-event
::wrk/queue :webhooks
::wrk/max-retries 0
::wrk/delay (or batch-timeout 0)
::wrk/dedupe dedupe?
::wrk/label label
::webhooks/event
(-> params
(dissoc :ip-addr)
(dissoc :type)))))
(wrk/submit! (-> cfg
(assoc ::wrk/task :process-webhook-event)
(assoc ::wrk/queue :webhooks)
(assoc ::wrk/max-retries 0)
(assoc ::wrk/delay (or batch-timeout 0))
(assoc ::wrk/dedupe dedupe?)
(assoc ::wrk/label label)
(assoc ::wrk/params (-> params
(dissoc :ip-addr)
(dissoc :type)))))))
params))
(defn submit!
"Submit audit event to the collector."
[cfg params]
[cfg event]
(try
(let [event (d/without-nils params)
(let [event (d/without-nils event)
cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6)
@ -259,3 +280,18 @@
(rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable cause
(l/error :hint "unexpected error processing event" :cause cause))))
(defn insert!
"Submit audit event to the collector, intended to be used only from
command line helpers because this skips all webhooks and telemetry
logic."
[cfg event]
(when (contains? cf/flags :audit-log)
(let [event (d/without-nils event)]
(us/verify! ::event event)
(db/run! cfg (fn [cfg]
(let [tnow (dt/now)
params (-> (event->params event)
(assoc :created-at tnow)
(update :tracked-at #(or % tnow)))]
(append-audit-entry! cfg params)))))))

24
backend/src/app/loggers/webhooks.clj
View file

@ -64,22 +64,22 @@
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::process-event-handler
[_ {:keys [::db/pool] :as cfg}]
[_ cfg]
(fn [{:keys [props] :as task}]
(let [event (::event props)]
(let [event (:event props)]
(l/dbg :hint "process webhook event" :name (:name event))
(when-let [items (lookup-webhooks cfg event)]
(l/trc :hint "webhooks found for event" :total (count items))
(db/with-atomic [conn pool]
(doseq [item items]
(wrk/submit! ::wrk/conn conn
::wrk/task :run-webhook
::wrk/queue :webhooks
::wrk/max-retries 3
::event event
::config item)))))))
(db/tx-run! cfg (fn [cfg]
(doseq [item items]
(wrk/submit! (-> cfg
(assoc ::wrk/task :run-webhook)
(assoc ::wrk/queue :webhooks)
(assoc ::wrk/max-retries 3)
(assoc ::wrk/params {:event event
:config item}))))))))))
;; --- RUN
@ -128,8 +128,8 @@
:rsp-data (db/tjson rsp)}))]
(fn [{:keys [props] :as task}]
(let [event (::event props)
whook (::config props)
(let [event (:event props)
whook (:config props)
body (case (:mtype whook)
"application/json" (json/write-str event json-write-opts)

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

@ -102,13 +102,13 @@
{::mdef/name "penpot_tasks_timing"
::mdef/help "Background tasks timing (milliseconds)."
::mdef/labels ["name"]
::mdef/type :summary}
::mdef/type :histogram}
:redis-eval-timing
{::mdef/name "penpot_redis_eval_timing"
::mdef/help "Redis EVAL commands execution timings (ms)"
::mdef/labels ["name"]
::mdef/type :summary}
::mdef/type :histogram}
:rpc-climit-queue
{::mdef/name "penpot_rpc_climit_queue"
@ -126,7 +126,7 @@
{::mdef/name "penpot_rpc_climit_timing"
::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
::mdef/labels ["name"]
::mdef/type :summary}
::mdef/type :histogram}
:audit-http-handler-queue-size
{::mdef/name "penpot_audit_http_handler_queue_size"
@ -144,7 +144,7 @@
{::mdef/name "penpot_audit_http_handler_timing"
::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
::mdef/labels []
::mdef/type :summary}
::mdef/type :histogram}
:executors-active-threads
{::mdef/name "penpot_executors_active_threads"
@ -254,7 +254,7 @@
{::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/gitlab
{}
{::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/generic
{::http.client/client (ig/ref ::http.client/client)}
@ -267,7 +267,9 @@
:github (ig/ref ::oidc.providers/github)
:gitlab (ig/ref ::oidc.providers/gitlab)
:oidc (ig/ref ::oidc.providers/generic)}
::session/manager (ig/ref ::session/manager)}
::session/manager (ig/ref ::session/manager)
::email/blacklist (ig/ref ::email/blacklist)
::email/whitelist (ig/ref ::email/whitelist)}
:app.http/router
{::session/manager (ig/ref ::session/manager)
@ -322,7 +324,10 @@
::rpc/climit (ig/ref ::rpc/climit)
::rpc/rlimit (ig/ref ::rpc/rlimit)
::setup/templates (ig/ref ::setup/templates)
::setup/props (ig/ref ::setup/props)}
::setup/props (ig/ref ::setup/props)
::email/blacklist (ig/ref ::email/blacklist)
::email/whitelist (ig/ref ::email/whitelist)}
:app.rpc.doc/routes
{:methods (ig/ref :app.rpc/methods)}
@ -338,7 +343,6 @@
::wrk/tasks
{:sendmail (ig/ref ::email/handler)
:objects-gc (ig/ref :app.tasks.objects-gc/handler)
:orphan-teams-gc (ig/ref :app.tasks.orphan-teams-gc/handler)
:file-gc (ig/ref :app.tasks.file-gc/handler)
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
@ -356,6 +360,12 @@
:run-webhook
(ig/ref ::webhooks/run-webhook-handler)}}
::email/blacklist
{}
::email/whitelist
{}
::email/sendmail
{::email/host (cf/get :smtp-host)
::email/port (cf/get :smtp-port)
@ -377,9 +387,6 @@
{::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)}
:app.tasks.orphan-teams-gc/handler
{::db/pool (ig/ref ::db/pool)}
:app.tasks.delete-object/handler
{::db/pool (ig/ref ::db/pool)}
@ -468,9 +475,6 @@
{:cron #app/cron "0 0 0 * * ?" ;; daily
:task :objects-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily
:task :orphan-teams-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily
:task :storage-gc-deleted}
@ -520,6 +524,7 @@
(defn start
[]
(cf/validate!)
(ig/load-namespaces (merge system-config worker-config))
(alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys))

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

@ -11,7 +11,6 @@
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.spec :as us]
[app.common.svg :as csvg]
@ -47,19 +46,7 @@
(s/keys :req-un [::path]
:opt-un [::mtype]))
(sm/def! ::fs/path
{:type ::fs/path
:pred fs/path?
:type-properties
{:title "path"
:description "filesystem path"
:error/message "expected a valid fs path instance"
:gen/gen (sg/generator :string)
::oapi/type "string"
::oapi/format "unix-path"
::oapi/decode fs/path}})
(sm/def! ::upload
(sm/register! ::upload
[:map {:title "Upload"}
[:filename :string]
[:size :int]

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

@ -29,6 +29,7 @@
[app.rpc.rlimit :as rlimit]
[app.setup :as-alias setup]
[app.storage :as-alias sto]
[app.util.inet :as inet]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
@ -70,6 +71,22 @@
(handle-response-transformation request mdata)
(handle-before-comple-hook mdata))))
(defn get-external-session-id
[request]
(when-let [session-id (rreq/get-header request "x-external-session-id")]
(when-not (or (> (count session-id) 256)
(= session-id "null")
(str/blank? session-id))
session-id)))
(defn- get-external-event-origin
[request]
(when-let [origin (rreq/get-header request "x-event-origin")]
(when-not (or (> (count origin) 256)
(= origin "null")
(str/blank? origin))
origin)))
(defn- rpc-handler
"Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow."
@ -79,8 +96,16 @@
profile-id (or (::session/profile-id request)
(::actoken/profile-id request))
ip-addr (inet/parse-request request)
session-id (get-external-session-id request)
event-origin (get-external-event-origin request)
data (-> params
(assoc ::handler-name handler-name)
(assoc ::ip-addr ip-addr)
(assoc ::request-at (dt/now))
(assoc ::external-session-id session-id)
(assoc ::external-event-origin event-origin)
(assoc ::session/id (::session/id request))
(assoc ::cond/key etag)
(cond-> (uuid? profile-id)
@ -188,10 +213,10 @@
(defn- wrap-all
[cfg f mdata]
(as-> f $
(wrap-metrics cfg $ mdata)
(cond/wrap cfg $ mdata)
(retry/wrap-retry cfg $ mdata)
(climit/wrap cfg $ mdata)
(wrap-metrics cfg $ mdata)
(rlimit/wrap cfg $ mdata)
(wrap-audit cfg $ mdata)
(wrap-spec-conform cfg $ mdata)

37
backend/src/app/rpc/commands/access_token.clj
View file

@ -6,7 +6,7 @@
(ns app.rpc.commands.access-token
(:require
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.db :as db]
[app.main :as-alias main]
@ -16,8 +16,7 @@
[app.setup :as-alias setup]
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
[app.util.time :as dt]))
(defn- decode-row
[row]
@ -44,7 +43,7 @@
:perms (db/create-array conn "text" [])})))
(defn repl-create-access-token
(defn repl:create-access-token
[{:keys [::db/pool] :as system} profile-id name expiration]
(db/with-atomic [conn pool]
(let [props (:app.setup/props system)]
@ -53,16 +52,14 @@
name
expiration))))
(s/def ::name ::us/not-empty-string)
(s/def ::expiration ::dt/duration)
(s/def ::create-access-token
(s/keys :req [::rpc/profile-id]
:req-un [::name]
:opt-un [::expiration]))
(def ^:private schema:create-access-token
[:map {:title "create-access-token"}
[:name [:string {:max 250 :min 1}]]
[:expiration {:optional true} ::dt/duration]])
(sv/defmethod ::create-access-token
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:create-access-token}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name expiration]}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg ::db/conn conn)]
@ -72,21 +69,23 @@
(-> (create-access-token cfg profile-id name expiration)
(decode-row)))))
(s/def ::delete-access-token
(s/keys :req [::rpc/profile-id]
:req-un [::us/id]))
(def ^:private schema:delete-access-token
[:map {:title "delete-access-token"}
[:id ::sm/uuid]])
(sv/defmethod ::delete-access-token
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:delete-access-token}
[{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
(db/delete! pool :access-token {:id id :profile-id profile-id})
nil)
(s/def ::get-access-tokens
(s/keys :req [::rpc/profile-id]))
(def ^:private schema:get-access-tokens
[:map {:title "get-access-tokens"}])
(sv/defmethod ::get-access-tokens
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:get-access-tokens}
[{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
(->> (db/query pool :access-token
{:profile-id profile-id}

18
backend/src/app/rpc/commands/audit.clj
View file

@ -14,11 +14,12 @@
[app.config :as cf]
[app.db :as db]
[app.http :as-alias http]
[app.loggers.audit :as audit]
[app.loggers.audit :as-alias audit]
[app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.util.inet :as inet]
[app.util.services :as sv]
[app.util.time :as dt]))
@ -61,7 +62,7 @@
(defn- handle-events
[{:keys [::db/pool]} {:keys [::rpc/profile-id events] :as params}]
(let [request (-> params meta ::http/request)
ip-addr (audit/parse-client-ip request)
ip-addr (inet/parse-request request)
tnow (dt/now)
xform (comp
(map (fn [event]
@ -77,10 +78,19 @@
(when (seq events)
(db/insert-many! pool :audit-log event-columns events))))
(def valid-event-types
#{"action" "identify"})
(def schema:event
[:map {:title "Event"}
[:name [:string {:max 250}]]
[:type [:string {:max 250}]]
[:name
[:and {:gen/elements ["update-file", "get-profile"]}
[:string {:max 250}]
[:re #"[\d\w-]{1,50}"]]]
[:type
[:and {:gen/elements valid-event-types}
[:string {:max 250}]
[::sm/one-of {:format "string"} valid-event-types]]]
[:props
[:map-of :keyword :any]]
[:context {:optional true}

161
backend/src/app/rpc/commands/auth.clj
View file

@ -6,7 +6,6 @@
(ns app.rpc.commands.auth
(:require
[app.auth :as auth]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
@ -17,6 +16,8 @@
[app.config :as cf]
[app.db :as db]
[app.email :as eml]
[app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist]
[app.http.session :as session]
[app.loggers.audit :as audit]
[app.rpc :as-alias rpc]
@ -37,13 +38,11 @@
(def schema:token
[::sm/word-string {:max 6000}])
(def ^:private default-verify-threshold
(dt/duration "15m"))
(defn- elapsed-verify-threshold?
[profile]
(let [elapsed (dt/diff (:modified-at profile) (dt/now))]
(pos? (compare elapsed default-verify-threshold))))
(let [elapsed (dt/diff (:modified-at profile) (dt/now))
verify-threshold (cf/get :email-verify-threshold)]
(pos? (compare elapsed verify-threshold))))
;; ---- COMMAND: login with password
@ -129,12 +128,21 @@
;; ---- COMMAND: Logout
(def ^:private schema:logout
[:map {:title "logoug"}
[:profile-id {:optional true} ::sm/uuid]])
(sv/defmethod ::logout
"Clears the authentication cookie and logout the current session."
{::rpc/auth false
::doc/added "1.15"}
[cfg _]
(rph/with-transform {} (session/delete-fn cfg)))
::doc/changes [["2.1" "Now requires profile-id passed in the body"]]
::doc/added "1.0"
::sm/params schema:logout}
[cfg params]
(if (= (:profile-id params)
(::rpc/profile-id params))
(rph/with-transform {} (session/delete-fn cfg))
{}))
;; ---- COMMAND: Recover Profile
@ -186,8 +194,14 @@
:code :email-does-not-match-invitation
:hint "email should match the invitation"))))
(when-not (auth/email-domain-in-whitelist? (:email params))
(ex/raise :type :validation
(when (and (email.blacklist/enabled? cfg)
(email.blacklist/contains? cfg (:email params)))
(ex/raise :type :restriction
:code :email-domain-is-not-allowed))
(when (and (email.whitelist/enabled? cfg)
(not (email.whitelist/contains? cfg (:email params))))
(ex/raise :type :restriction
:code :email-domain-is-not-allowed))
;; Perform a basic validation of email & password
@ -195,7 +209,19 @@
(str/lower (:password params)))
(ex/raise :type :validation
:code :email-as-password
:hint "you can't use your email as password")))
:hint "you can't use your email as password"))
(when (eml/has-bounce-reports? cfg (:email params))
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email (:email params)
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? cfg (:email params))
(ex/raise :type :restriction
:code :email-has-complaints
:email (:email params)
:hint "looks like the email has complaint reports")))
(defn prepare-register
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
@ -272,14 +298,17 @@
(try
(-> (db/insert! conn :profile params)
(profile/decode-row))
(catch org.postgresql.util.PSQLException e
(let [state (.getSQLState e)]
(catch org.postgresql.util.PSQLException cause
(let [state (.getSQLState cause)]
(if (not= state "23505")
(throw e)
(ex/raise :type :validation
:code :email-already-exists
:hint "email already exists"
:cause e)))))))
(throw cause)
(do
(l/error :hint "not an error" :cause cause)
(ex/raise :type :validation
:code :email-already-exists
:hint "email already exists"
:cause cause))))))))
(defn create-profile-rels!
[conn {:keys [id] :as profile}]
@ -326,7 +355,7 @@
profile (if-let [profile-id (:profile-id claims)]
(profile/get-profile conn profile-id)
(let [is-active (or (boolean (:is-active params))
(let [is-active (or (boolean (:is-active claims))
(not (contains? cf/flags :email-verification)))
params (-> params
(assoc :is-active is-active)
@ -334,6 +363,9 @@
(->> (create-profile! conn params)
(create-profile-rels! conn))))
;; When no profile-id comes on claims means a new register
created? (not (:profile-id claims))
invitation (when-let [token (:invitation-token params)]
(tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
@ -371,8 +403,8 @@
;; When a new user is created and it is already activated by
;; configuration or specified by OIDC, we just mark the profile
;; as logged-in
(not (:profile-id claims))
(if (:is-active claims)
created?
(if (:is-active profile)
(-> (profile/strip-private-attrs profile)
(rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta
@ -381,20 +413,22 @@
::audit/profile-id (:id profile)}))
(do
(send-email-verification! cfg profile)
(when-not (eml/has-reports? conn (:email profile))
(send-email-verification! cfg profile))
(rph/with-meta {:email (:email profile)}
{::audit/replace-props props
::audit/context {:action "email-verification"}
::audit/profile-id (:id profile)})))
:else
(let [elapsed? (elapsed-verify-threshold? profile)
bounce? (eml/has-bounce-reports? conn (:email profile))
action (if bounce?
"ignore-because-bounce"
(if elapsed?
"resend-email-verification"
"ignore"))]
(let [elapsed? (elapsed-verify-threshold? profile)
complaints? (eml/has-reports? conn (:email profile))
action (if complaints?
"ignore-because-complaints"
(if elapsed?
"resend-email-verification"
"ignore"))]
(l/wrn :hint "repeated registry detected"
:profile-id (str (:id profile))
@ -423,15 +457,13 @@
::doc/added "1.15"
::sm/params schema:register-profile
::climit/id :auth/global}
[{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool]
(-> (assoc cfg ::db/conn conn)
(register-profile params))))
[cfg params]
(db/tx-run! cfg register-profile params))
;; ---- COMMAND: Request Profile Recovery
(defn- request-profile-recovery
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [email] :as params}]
(letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (::setup/props cfg)
{:iss :password-recovery
@ -453,39 +485,42 @@
:extra-data ptoken})
nil))]
(db/with-atomic [conn pool]
(let [profile (->> (profile/clean-email email)
(profile/get-profile-by-email conn))]
(let [profile (->> (profile/clean-email email)
(profile/get-profile-by-email conn))]
(cond
(not profile)
(l/wrn :hint "attempt of profile recovery: no profile found"
:profile-email email)
(cond
(not profile)
(l/wrn :hint "attempt of profile recovery: no profile found"
:profile-email email)
(not (eml/allow-send-emails? conn profile))
(l/wrn :hint "attempt of profile recovery: profile is muted"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (eml/allow-send-emails? conn profile))
(l/wrn :hint "attempt of profile recovery: profile is muted"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-bounce-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has bounces"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-bounce-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has bounces"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (elapsed-verify-threshold? profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-complaint-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has complaints"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (elapsed-verify-threshold? profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
:profile-id (str (:id profile))
:profile-email (:email profile))
:else
(do
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(->> profile
(create-recovery-token)
(send-email-notification conn))))))))
:else
(do
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(->> profile
(create-recovery-token)
(send-email-notification conn)))))))
(def schema:request-profile-recovery
@ -497,6 +532,6 @@
::doc/added "1.15"
::sm/params schema:request-profile-recovery}
[cfg params]
(request-profile-recovery cfg params))
(db/tx-run! cfg request-profile-recovery params))

20
backend/src/app/rpc/commands/binfile.clj
View file

@ -32,12 +32,11 @@
(def ^:private
schema:export-binfile
(sm/define
[:map {:title "export-binfile"}
[:name :string]
[:file-id ::sm/uuid]
[:include-libraries :boolean]
[:embed-assets :boolean]]))
[:map {:title "export-binfile"}
[:name [:string {:max 250}]]
[:file-id ::sm/uuid]
[:include-libraries :boolean]
[:embed-assets :boolean]])
(sv/defmethod ::export-binfile
"Export a penpot file in a binary format."
@ -78,11 +77,10 @@
(def ^:private
schema:import-binfile
(sm/define
[:map {:title "import-binfile"}
[:name :string]
[:project-id ::sm/uuid]
[:file ::media/upload]]))
[:map {:title "import-binfile"}
[:name [:string {:max 250}]]
[:project-id ::sm/uuid]
[:file ::media/upload]])
(sv/defmethod ::import-binfile
"Import a penpot file in a binary format."

6
backend/src/app/rpc/commands/comments.clj
View file

@ -292,7 +292,7 @@
[:map {:title "create-comment-thread"}
[:file-id ::sm/uuid]
[:position ::gpt/point]
[:content :string]
[:content [:string {:max 250}]]
[:page-id ::sm/uuid]
[:frame-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
@ -418,7 +418,7 @@
schema:create-comment
[:map {:title "create-comment"}
[:thread-id ::sm/uuid]
[:content :string]
[:content [:string {:max 250}]]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::create-comment
@ -477,7 +477,7 @@
schema:update-comment
[:map {:title "update-comment"}
[:id ::sm/uuid]
[:content :string]
[:content [:string {:max 250}]]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment

7
backend/src/app/rpc/commands/demo.clj
View file

@ -18,10 +18,7 @@
[app.util.services :as sv]
[app.util.time :as dt]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]
[clojure.spec.alpha :as s]))
(s/def ::create-demo-profile any?)
[buddy.core.nonce :as bn]))
(sv/defmethod ::create-demo-profile
"A command that is responsible of creating a demo purpose
@ -48,7 +45,7 @@
params {:email email
:fullname fullname
:is-active true
:deleted-at (dt/in-future cf/deletion-delay)
:deleted-at (dt/in-future (cf/get-deletion-delay))
:password (profile/derive-password cfg password)
:props {}}]

20
backend/src/app/rpc/commands/feedback.clj
View file

@ -8,29 +8,25 @@
"A general purpose feedback module."
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.config :as cf]
[app.db :as db]
[app.email :as eml]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
[app.util.services :as sv]))
(declare ^:private send-feedback!)
(s/def ::content ::us/string)
(s/def ::from ::us/email)
(s/def ::subject ::us/string)
(s/def ::send-user-feedback
(s/keys :req [::rpc/profile-id]
:req-un [::subject
::content]))
(def ^:private schema:send-user-feedback
[:map {:title "send-user-feedback"}
[:subject [:string {:max 250}]]
[:content [:string {:max 250}]]])
(sv/defmethod ::send-user-feedback
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:send-user-feedback}
[{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
(when-not (contains? cf/flags :user-feedback)
(ex/raise :type :restriction

50
backend/src/app/rpc/commands/files.clj
View file

@ -15,7 +15,6 @@
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj]
[app.common.spec :as us]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
[app.config :as cf]
@ -36,7 +35,6 @@
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
;; --- FEATURES
@ -46,18 +44,6 @@
(when media-id
(str (cf/get :public-uri) "/assets/by-id/" media-id)))
;; --- SPECS
(s/def ::features ::us/set-of-strings)
(s/def ::file-id ::us/uuid)
(s/def ::frame-id ::us/uuid)
(s/def ::id ::us/uuid)
(s/def ::is-shared ::us/boolean)
(s/def ::name ::us/string)
(s/def ::project-id ::us/uuid)
(s/def ::search-term ::us/string)
(s/def ::team-id ::us/uuid)
;; --- HELPERS
(def long-cache-duration
@ -191,7 +177,7 @@
[:features ::cfeat/features]
[:has-media-trimmed :boolean]
[:comment-thread-seqn {:min 0} :int]
[:name :string]
[:name [:string {:max 250}]]
[:revn {:min 0} :int]
[:modified-at ::dt/instant]
[:is-shared :boolean]
@ -671,7 +657,7 @@
f.modified_at,
f.name,
f.is_shared,
ft.media_id,
ft.media_id AS thumbnail_id,
row_number() over w as row_num
from file as f
inner join project as p on (p.id = f.project_id)
@ -690,10 +676,8 @@
[conn team-id]
(->> (db/exec! conn [sql:team-recent-files team-id])
(mapv (fn [row]
(if-let [media-id (:media-id row)]
(-> row
(dissoc :media-id)
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(if-let [media-id (:thumbnail-id row)]
(assoc row :thumbnail-uri (resolve-public-uri media-id))
(dissoc row :media-id))))))
(def ^:private schema:get-team-recent-files
@ -761,19 +745,19 @@
[:map {:title "RenameFileEvent"}
[:id ::sm/uuid]
[:project-id ::sm/uuid]
[:name :string]
[:name [:string {:max 250}]]
[:created-at ::dt/instant]
[:modified-at ::dt/instant]]
::sm/params
[:map {:title "RenameFileParams"}
[:name {:min 1} :string]
[:name [:string {:min 1 :max 250}]]
[:id ::sm/uuid]]
::sm/result
[:map {:title "SimplifiedFile"}
[:id ::sm/uuid]
[:name :string]
[:name [:string {:max 250}]]
[:created-at ::dt/instant]
[:modified-at ::dt/instant]]}
@ -927,11 +911,11 @@
{:id file-id}
{::db/return-keys [:id :name :is-shared :deleted-at
:project-id :created-at :modified-at]})]
(wrk/submit! {::wrk/task :delete-object
::wrk/conn conn
:object :file
:deleted-at (:deleted-at file)
:id file-id})
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :file
:deleted-at (:deleted-at file)
:id file-id}})
file))
(def ^:private
@ -1047,14 +1031,16 @@
{:id file-id}
{::db/return-keys true}))
(s/def ::ignore-file-library-sync-status
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::date]))
(def ^:private schema:ignore-file-library-sync-status
[:map {:title "ignore-file-library-sync-status"}
[:file-id ::sm/uuid]
[:date ::dt/duration]])
;; TODO: improve naming
(sv/defmethod ::ignore-file-library-sync-status
"Ignore updates in linked files"
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:ignore-file-library-sync-status}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)

2
backend/src/app/rpc/commands/files_create.clj
View file

@ -88,7 +88,7 @@
(def ^:private schema:create-file
[:map {:title "create-file"}
[:name :string]
[:name [:string {:max 250}]]
[:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid]
[:is-shared {:optional true} :boolean]

33
backend/src/app/rpc/commands/files_share.clj
View file

@ -7,29 +7,24 @@
(ns app.rpc.commands.files-share
"Share link related rpc mutation methods."
(:require
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Helpers & Specs
(s/def ::file-id ::us/uuid)
(s/def ::who-comment ::us/string)
(s/def ::who-inspect ::us/string)
(s/def ::pages (s/every ::us/uuid :kind set?))
[app.util.services :as sv]))
;; --- MUTATION: Create Share Link
(declare create-share-link)
(s/def ::create-share-link
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::who-comment ::who-inspect ::pages]))
(def ^:private schema:create-share-link
[:map {:title "create-share-link"}
[:file-id ::sm/uuid]
[:who-comment [:string {:max 250}]]
[:who-inspect [:string {:max 250}]]
[:pages [:set ::sm/uuid]]])
(sv/defmethod ::create-share-link
"Creates a share-link object.
@ -37,7 +32,8 @@
Share links are resources that allows external users access to specific
pages of a file with specific permissions (who-comment and who-inspect)."
{::doc/added "1.18"
::doc/module :files}
::doc/module :files
::sm/params schema:create-share-link}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
@ -58,13 +54,14 @@
;; --- MUTATION: Delete Share Link
(s/def ::delete-share-link
(s/keys :req [::rpc/profile-id]
:req-un [::us/id]))
(def ^:private schema:delete-share-link
[:map {:title "delete-share-link"}
[:id ::sm/uuid]])
(sv/defmethod ::delete-share-link
{::doc/added "1.18"
::doc/module ::files}
::doc/module ::files
::sm/params schema:delete-share-link}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [slink (db/get-by-id conn :share-link id)]

2
backend/src/app/rpc/commands/files_temp.clj
View file

@ -35,7 +35,7 @@
(def ^:private schema:create-temp-file
[:map {:title "create-temp-file"}
[:name :string]
[:name [:string {:max 250}]]
[:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid]
[:is-shared :boolean]

37
backend/src/app/rpc/commands/files_thumbnails.clj
View file

@ -33,7 +33,6 @@
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
;; --- FEATURES
@ -86,11 +85,8 @@
::doc/module :files
::sm/params [:map {:title "get-file-object-thumbnails"}
[:file-id ::sm/uuid]
[:tag {:optional true} :string]]
::sm/result [:map-of :string :string]
::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
::cond/reuse-key? true
::cond/key-fn files/get-file-etag}
[:tag {:optional true} [:string {:max 50}]]]
::sm/result [:map-of [:string {:max 250}] [:string {:max 250}]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id tag] :as params}]
(dm/with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id)
@ -279,9 +275,9 @@
schema:create-file-object-thumbnail
[:map {:title "create-file-object-thumbnail"}
[:file-id ::sm/uuid]
[:object-id :string]
[:object-id [:string {:max 250}]]
[:media ::media/upload]
[:tag {:optional true} :string]])
[:tag {:optional true} [:string {:max 50}]]])
(sv/defmethod ::create-file-object-thumbnail
{::doc/added "1.19"
@ -317,25 +313,23 @@
:object-id object-id
:tag tag})))
(s/def ::delete-file-object-thumbnail
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::object-id]))
(def ^:private schema:delete-file-object-thumbnail
[:map {:title "delete-file-object-thumbnail"}
[:file-id ::sm/uuid]
[:object-id [:string {:max 250}]]])
(sv/defmethod ::delete-file-object-thumbnail
{::doc/added "1.19"
::doc/module :files
::doc/deprecated "1.20"
::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
[:file-thumbnail-ops/global]]
::sm/params schema:delete-file-object-thumbnail
::audit/skip true}
[cfg {:keys [::rpc/profile-id file-id object-id]}]
(files/check-edition-permissions! cfg profile-id file-id)
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id)
(when-not (db/read-only? conn)
(-> cfg
(update ::sto/storage media/configure-assets-storage conn)
(delete-file-object-thumbnail! file-id object-id))
nil))))
(-> cfg
(update ::sto/storage media/configure-assets-storage conn)
(delete-file-object-thumbnail! file-id object-id))
nil)))
;; --- MUTATION COMMAND: create-file-thumbnail
@ -413,4 +407,5 @@
(when-not (db/read-only? conn)
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)
media (create-file-thumbnail! cfg params)]
{:uri (files/resolve-public-uri (:id media))})))))
{:uri (files/resolve-public-uri (:id media))
:id (:id media)})))))

113
backend/src/app/rpc/commands/files_update.clj
View file

@ -51,7 +51,7 @@
[:vector [:map
[:changes [:vector ::cpc/change]]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]]]]
[:hint-events {:optional true} [:vector [:string {:max 250}]]]]]]
[:skip-validate {:optional true} :boolean]])
(def ^:private
@ -123,12 +123,13 @@
(feat.fdata/persist-pointers! cfg id)
result))))
(declare get-lagged-changes)
(declare send-notifications!)
(declare update-file)
(declare update-file*)
(declare update-file-data)
(declare take-snapshot?)
(declare ^:private delete-old-snapshots!)
(declare ^:private get-lagged-changes)
(declare ^:private send-notifications!)
(declare ^:private take-snapshot?)
(declare ^:private update-file)
(declare ^:private update-file*)
(declare ^:private update-file-data)
;; If features are specified from params and the final feature
;; set is different than the persisted one, update it on the
@ -238,12 +239,15 @@
:created-at created-at
:file-id (:id file)
:revn (:revn file)
:label (::snapshot-label file)
:data (::snapshot-data file)
:features (db/create-array conn "text" (:features file))
:data (when (take-snapshot? file)
(:data file))
:changes (blob/encode changes)}
{::db/return-keys false})
(when (::snapshot-data file)
(delete-old-snapshots! cfg file))
(db/update! conn :file
{:revn (:revn file)
:data (:data file)
@ -262,8 +266,8 @@
;; Send asynchronous notifications
(send-notifications! cfg params)
;; Retrieve and return lagged data
(get-lagged-changes conn params))))
{:revn (:revn file)
:lagged (get-lagged-changes conn params)})))
(defn- soft-validate-file-schema!
[file]
@ -286,7 +290,6 @@
(-> data
(blob/decode)
(assoc :id (:id file)))))
;; For avoid unnecesary overhead of creating multiple pointers
;; and handly internally with objects map in their worst
;; case (when probably all shapes and all pointers will be
@ -322,21 +325,42 @@
file (-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils))]
(update :data d/without-nils))
(when (contains? cf/flags :soft-file-validation)
(soft-validate-file! file libs))
file (if (take-snapshot? file)
(let [tpoint (dt/tpoint)
snapshot (-> (:data file)
(feat.fdata/process-pointers deref)
(feat.fdata/process-objects (partial into {}))
(blob/encode))
elapsed (tpoint)
label (str "internal/snapshot/" (:revn file))]
(when (contains? cf/flags :soft-file-schema-validation)
(soft-validate-file-schema! file))
(l/trc :hint "take snapshot"
:file-id (str (:id file))
:revn (:revn file)
:label label
:elapsed (dt/format-duration elapsed))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(val/validate-file! file libs))
(-> file
(assoc ::snapshot-data snapshot)
(assoc ::snapshot-label label)))
file)]
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(val/validate-file-schema! file))
(binding [pmap/*tracked* nil]
(when (contains? cf/flags :soft-file-validation)
(soft-validate-file! file libs))
(when (contains? cf/flags :soft-file-schema-validation)
(soft-validate-file-schema! file))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(val/validate-file! file libs))
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(val/validate-file-schema! file)))
(cond-> file
(contains? cfeat/*current* "fdata/objects-map")
@ -351,13 +375,42 @@
(defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved."
[{:keys [revn modified-at] :as file}]
(let [freq (or (cf/get :file-change-snapshot-every) 20)
timeout (or (cf/get :file-change-snapshot-timeout)
(dt/duration {:hours 1}))]
(or (= 1 freq)
(zero? (mod revn freq))
(> (inst-ms (dt/diff modified-at (dt/now)))
(inst-ms timeout)))))
(when (contains? cf/flags :file-snapshot)
(let [freq (or (cf/get :file-snapshot-every) 20)
timeout (or (cf/get :file-snapshot-timeout)
(dt/duration {:hours 1}))]
(or (= 1 freq)
(zero? (mod revn freq))
(> (inst-ms (dt/diff modified-at (dt/now)))
(inst-ms timeout))))))
;; Get the latest available snapshots without exceeding the total
;; snapshot limit.
(def ^:private sql:get-latest-snapshots
"SELECT fch.id, fch.created_at
FROM file_change AS fch
WHERE fch.file_id = ?
AND fch.label LIKE 'internal/%'
ORDER BY fch.created_at DESC
LIMIT ?")
;; Mark all snapshots that are outside the allowed total threshold
;; available for the GC.
(def ^:private sql:delete-snapshots
"UPDATE file_change
SET label = NULL
WHERE file_id = ?
AND label IS NOT NULL
AND created_at < ?")
(defn- delete-old-snapshots!
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(when-let [snapshots (not-empty (db/exec! conn [sql:get-latest-snapshots id
(cf/get :file-snapshot-total 10)]))]
(let [last-date (-> snapshots peek :created-at)
result (db/exec-one! conn [sql:delete-snapshots id last-date])]
(l/trc :hint "delete old snapshots" :file-id (str id) :total (db/get-update-count result)))))
(def ^:private
sql:lagged-changes

20
backend/src/app/rpc/commands/ldap.clj
View file

@ -8,7 +8,7 @@
(:require
[app.auth.ldap :as ldap]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.db :as db]
[app.http.session :as session]
[app.loggers.audit :as-alias audit]
@ -19,27 +19,25 @@
[app.rpc.helpers :as rph]
[app.setup :as-alias setup]
[app.tokens :as tokens]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
[app.util.services :as sv]))
;; --- COMMAND: login-with-ldap
(declare login-or-register)
(s/def ::email ::us/email)
(s/def ::password ::us/string)
(s/def ::invitation-token ::us/string)
(s/def ::login-with-ldap
(s/keys :req-un [::email ::password]
:opt-un [::invitation-token]))
(def schema:login-with-ldap
[:map {:title "login-with-ldap"}
[:email ::sm/email]
[:password auth/schema:password]
[:invitation-token {:optional true} auth/schema:token]])
(sv/defmethod ::login-with-ldap
"Performs the authentication using LDAP backend. Only works if LDAP
is properly configured and enabled with `login-with-ldap` flag."
{::rpc/auth false
::doc/added "1.15"
::doc/module :auth}
::doc/module :auth
::sm/params schema:login-with-ldap}
[{:keys [::setup/props ::ldap/provider] :as cfg} params]
(when-not provider
(ex/raise :type :restriction

34
backend/src/app/rpc/commands/management.clj
View file

@ -16,6 +16,7 @@
[app.config :as cf]
[app.db :as db]
[app.http.sse :as sse]
[app.loggers.audit :as audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
@ -90,7 +91,7 @@
(sm/define
[:map {:title "duplicate-file"}
[:file-id ::sm/uuid]
[:name {:optional true} :string]]))
[:name {:optional true} [:string {:max 250}]]]))
(sv/defmethod ::duplicate-file
"Duplicate a single file in the same team."
@ -152,7 +153,7 @@
(sm/define
[:map {:title "duplicate-project"}
[:project-id ::sm/uuid]
[:name {:optional true} :string]]))
[:name {:optional true} [:string {:max 250}]]]))
(sv/defmethod ::duplicate-project
"Duplicate an entire project with all the files"
@ -397,17 +398,30 @@
;; --- COMMAND: Clone Template
(defn- clone-template
[{:keys [::wrk/executor ::bf.v1/project-id] :as cfg} template]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
[cfg {:keys [project-id ::rpc/profile-id] :as params} template]
(db/tx-run! cfg (fn [{:keys [::db/conn ::wrk/executor] :as cfg}]
;; NOTE: the importation process performs some operations that
;; are not very friendly with virtual threads, and for avoid
;; unexpected blocking of other concurrent operations we
;; dispatch that operation to a dedicated executor.
(let [result (px/submit! executor (partial bf.v1/import-files! cfg template))]
(let [cfg (-> cfg
(assoc ::bf.v1/project-id project-id)
(assoc ::bf.v1/profile-id profile-id))
result (px/invoke! executor (partial bf.v1/import-files! cfg template))]
(db/update! conn :project
{:modified-at (dt/now)}
{:id project-id})
(deref result)))))
(let [props (audit/clean-props params)]
(doseq [file-id result]
(let [props (assoc props :id file-id)
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name "create-file")
(assoc ::audit/props props))]
(audit/submit! cfg event))))
result))))
(def ^:private
schema:clone-template
@ -425,16 +439,14 @@
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id template-id] :as params}]
(let [project (db/get-by-id pool :project project-id {:columns [:id :team-id]})
_ (teams/check-edition-permissions! pool profile-id (:team-id project))
template (tmpl/get-template-stream cfg template-id)
params (-> cfg
(assoc ::bf.v1/project-id (:id project))
(assoc ::bf.v1/profile-id profile-id))]
template (tmpl/get-template-stream cfg template-id)]
(when-not template
(ex/raise :type :not-found
:code :template-not-found
:hint "template not found"))
(sse/response #(clone-template params template))))
(sse/response #(clone-template cfg params template))))
;; --- COMMAND: Get list of builtin templates

47
backend/src/app/rpc/commands/media.clj
View file

@ -9,7 +9,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -25,7 +25,6 @@
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.exec :as px]))
@ -39,25 +38,21 @@
:quality 85
:format :jpeg})
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
;; --- Create File Media object (upload)
(declare create-file-media-object)
(s/def ::content ::media/upload)
(s/def ::is-local ::us/boolean)
(s/def ::upload-file-media-object
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::name ::content]
:opt-un [::id]))
(def ^:private schema:upload-file-media-object
[:map {:title "upload-file-media-object"}
[:id {:optional true} ::sm/uuid]
[:file-id ::sm/uuid]
[:is-local :boolean]
[:name [:string {:max 250}]]
[:content ::media/upload]])
(sv/defmethod ::upload-file-media-object
{::doc/added "1.17"
::sm/params schema:upload-file-media-object
::climit/id [[:process-image/by-profile ::rpc/profile-id]
[:process-image/global]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
@ -176,14 +171,17 @@
(declare ^:private create-file-media-object-from-url)
(s/def ::create-file-media-object-from-url
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::url]
:opt-un [::id ::name]))
(def ^:private schema:create-file-media-object-from-url
[:map {:title "create-file-media-object-from-url"}
[:file-id ::sm/uuid]
[:is-local :boolean]
[:url ::sm/uri]
[:id {:optional true} ::sm/uuid]
[:name {:optional true} [:string {:max 250}]]])
(sv/defmethod ::create-file-media-object-from-url
{::doc/added "1.17"
::doc/deprecated "1.19"}
::sm/params schema:create-file-media-object-from-url}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id)
@ -255,12 +253,15 @@
(declare clone-file-media-object)
(s/def ::clone-file-media-object
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::is-local ::id]))
(def ^:private schema:clone-file-media-object
[:map {:title "clone-file-media-object"}
[:file-id ::sm/uuid]
[:is-local :boolean]
[:id ::sm/uuid]])
(sv/defmethod ::clone-file-media-object
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:clone-file-media-object}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)

91
backend/src/app/rpc/commands/profile.clj
View file

@ -28,7 +28,7 @@
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[app.worker :as wrk]
[cuerdas.core :as str]
[promesa.exec :as px]))
@ -276,19 +276,19 @@
(sv/defmethod ::request-email-change
{::doc/added "1.0"
::sm/params schema:request-email-change}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
(db/with-atomic [conn pool]
(let [profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg ::conn conn)
params (assoc params
:profile profile
:email (clean-email email))]
(if (contains? cf/flags :smtp)
(request-email-change! cfg params)
(change-email-immediately! cfg params)))))
[cfg {:keys [::rpc/profile-id email] :as params}]
(db/tx-run! cfg
(fn [cfg]
(let [profile (db/get-by-id cfg :profile profile-id)
params (assoc params
:profile profile
:email (clean-email email))]
(if (contains? cf/flags :smtp)
(request-email-change! cfg params)
(change-email-immediately! cfg params))))))
(defn- change-email-immediately!
[{:keys [::conn]} {:keys [profile email] :as params}]
[{:keys [::db/conn]} {:keys [profile email] :as params}]
(when (not= email (:email profile))
(check-profile-existence! conn params))
@ -299,7 +299,7 @@
{:changed true})
(defn- request-email-change!
[{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile email] :as params}]
(let [token (tokens/generate (::setup/props cfg)
{:iss :change-email
:exp (dt/in-future "15m")
@ -319,9 +319,28 @@
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
:email email
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? conn email)
(ex/raise :type :restriction
:code :email-has-complaints
:email email
:hint "looks like the email has spam complaint reports"))
(when (eml/has-bounce-reports? conn (:email profile))
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email (:email profile)
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? conn (:email profile))
(ex/raise :type :restriction
:code :email-has-complaints
:email (:email profile)
:hint "looks like the email has spam complaint reports"))
(eml/send! {::eml/conn conn
::eml/factory eml/change-email
@ -366,13 +385,13 @@
;; --- MUTATION: Delete Profile
(declare ^:private get-owned-teams-with-participants)
(declare ^:private get-owned-teams)
(sv/defmethod ::delete-profile
{::doc/added "1.0"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(let [teams (get-owned-teams-with-participants conn profile-id)
(let [teams (get-owned-teams conn profile-id)
deleted-at (dt/now)]
;; If we found owned teams with participants, we don't allow
@ -384,37 +403,39 @@
:hint "The user need to transfer ownership of owned teams."
:context {:teams (mapv :id teams)}))
(doseq [{:keys [id]} teams]
(db/update! conn :team
{:deleted-at deleted-at}
{:id id}))
;; Mark profile deleted immediatelly
(db/update! conn :profile
{:deleted-at deleted-at}
{:id profile-id})
;; Schedule cascade deletion to a worker
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :profile
:deleted-at deleted-at
:id profile-id}})
(rph/with-transform {} (session/delete-fn cfg)))))
;; --- HELPERS
(def sql:owned-teams
"with owner_teams as (
select tpr.team_id as id
from team_profile_rel as tpr
where tpr.is_owner is true
and tpr.profile_id = ?
"WITH owner_teams AS (
SELECT tpr.team_id AS id
FROM team_profile_rel AS tpr
WHERE tpr.is_owner IS TRUE
AND tpr.profile_id = ?
)
select tpr.team_id as id,
count(tpr.profile_id) - 1 as participants
from team_profile_rel as tpr
where tpr.team_id in (select id from owner_teams)
and tpr.profile_id != ?
group by 1")
SELECT tpr.team_id AS id,
count(tpr.profile_id) - 1 AS participants
FROM team_profile_rel AS tpr
WHERE tpr.team_id IN (SELECT id from owner_teams)
GROUP BY 1")
(defn- get-owned-teams-with-participants
(defn get-owned-teams
[conn profile-id]
(db/exec! conn [sql:owned-teams profile-id profile-id]))
(db/exec! conn [sql:owned-teams profile-id]))
(def ^:private sql:profile-existence
"select exists (select * from profile

83
backend/src/app/rpc/commands/projects.clj
View file

@ -8,7 +8,7 @@
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.loggers.audit :as-alias audit]
@ -21,11 +21,7 @@
[app.rpc.quotes :as quotes]
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
[app.worker :as wrk]))
;; --- Check Project Permissions
@ -75,13 +71,13 @@
(declare get-projects)
(s/def ::team-id ::us/uuid)
(s/def ::get-projects
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def ^:private schema:get-projects
[:map {:title "get-projects"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-projects
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:get-projects}
[{:keys [::db/pool]} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
@ -112,11 +108,12 @@
(declare get-all-projects)
(s/def ::get-all-projects
(s/keys :req [::rpc/profile-id]))
(def ^:private schema:get-all-projects
[:map {:title "get-all-projects"}])
(sv/defmethod ::get-all-projects
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:get-all-projects}
[{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
(dm/with-open [conn (db/open pool)]
(get-all-projects conn profile-id)))
@ -154,12 +151,13 @@
;; --- QUERY: Get project
(s/def ::get-project
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
(def ^:private schema:get-project
[:map {:title "get-project"}
[:id ::sm/uuid]])
(sv/defmethod ::get-project
{::doc/added "1.18"}
{::doc/added "1.18"
::sm/params schema:get-project}
[{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
(dm/with-open [conn (db/open pool)]
(let [project (db/get-by-id conn :project id)]
@ -170,14 +168,16 @@
;; --- MUTATION: Create Project
(s/def ::create-project
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::name]
:opt-un [::id]))
(def ^:private schema:create-project
[:map {:title "create-project"}
[:team-id ::sm/uuid]
[:name [:string {:max 250 :min 1}]]
[:id {:optional true} ::sm/uuid]])
(sv/defmethod ::create-project
{::doc/added "1.18"
::webhooks/event? true}
::webhooks/event? true
::sm/params schema:create-project}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
@ -205,14 +205,15 @@
on conflict (team_id, project_id, profile_id)
do update set is_pinned=?")
(s/def ::is-pinned ::us/boolean)
(s/def ::project-id ::us/uuid)
(s/def ::update-project-pin
(s/keys :req [::rpc/profile-id]
:req-un [::id ::team-id ::is-pinned]))
(def ^:private schema:update-project-pin
[:map {:title "update-project-pin"}
[:team-id ::sm/uuid]
[:is-pinned :boolean]
[:id ::sm/uuid]])
(sv/defmethod ::update-project-pin
{::doc/added "1.18"
::sm/params schema:update-project-pin
::webhooks/batch-timeout (dt/duration "5s")
::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
::webhooks/event? true}
@ -226,12 +227,14 @@
(declare rename-project)
(s/def ::rename-project
(s/keys :req [::rpc/profile-id]
:req-un [::name ::id]))
(def ^:private schema:rename-project
[:map {:title "rename-project"}
[:name [:string {:max 250 :min 1}]]
[:id ::sm/uuid]])
(sv/defmethod ::rename-project
{::doc/added "1.18"
::sm/params schema:rename-project
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
(db/with-atomic [conn pool]
@ -258,20 +261,22 @@
:code :non-deletable-project
:hint "impossible to delete default project"))
(wrk/submit! {::wrk/task :delete-object
::wrk/conn conn
:object :project
:deleted-at (:deleted-at project)
:id project-id})
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :project
:deleted-at (:deleted-at project)
:id project-id}})
project))
(s/def ::delete-project
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
(def ^:private schema:delete-project
[:map {:title "delete-project"}
[:id ::sm/uuid]])
(sv/defmethod ::delete-project
{::doc/added "1.18"
::sm/params schema:delete-project
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]

19
backend/src/app/rpc/commands/search.clj
View file

@ -6,13 +6,12 @@
(ns app.rpc.commands.search
(:require
[app.common.spec :as us]
[app.common.schema :as sm]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :refer [resolve-public-uri]]
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
[app.util.services :as sv]))
(def ^:private sql:search-files
"with projects as (
@ -65,16 +64,14 @@
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(dissoc row :media-id))))))
(s/def ::team-id ::us/uuid)
(s/def ::search-files ::us/string)
(s/def ::search-files
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]
:opt-un [::search-term]))
(def ^:private schema:search-files
[:map {:title "search-files"}
[:team-id ::sm/uuid]
[:search-term {:optional true} :string]])
(sv/defmethod ::search-files
{::doc/added "1.17"
::doc/module :files}
::doc/module :files
::sm/params schema:search-files}
[{:keys [::db/pool]} {:keys [::rpc/profile-id team-id search-term]}]
(some->> search-term (search-files pool profile-id team-id)))

259
backend/src/app/rpc/commands/teams.clj
View file

@ -12,7 +12,6 @@
[app.common.features :as cfeat]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -32,16 +31,10 @@
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(def ^:private sql:team-permissions
"select tpr.is_owner,
tpr.is_admin,
@ -351,7 +344,7 @@
(def ^:private schema:create-team
[:map {:title "create-team"}
[:name :string]
[:name [:string {:max 250}]]
[:features {:optional true} ::cfeat/features]
[:id {:optional true} ::sm/uuid]])
@ -364,10 +357,12 @@
::quotes/profile-id profile-id})
(let [features (-> (cfeat/get-enabled-features cf/flags)
(cfeat/check-client-features! (:features params)))]
(create-team cfg (assoc params
:profile-id profile-id
:features features))))))
(cfeat/check-client-features! (:features params)))
team (create-team cfg (assoc params
:profile-id profile-id
:features features))]
(with-meta team
{::audit/props {:id (:id team)}})))))
(defn create-team
"This is a complete team creation process, it creates the team
@ -438,12 +433,14 @@
;; --- Mutation: Update Team
(s/def ::update-team
(s/keys :req [::rpc/profile-id]
:req-un [::name ::id]))
(def ^:private schema:update-team
[:map {:title "update-team"}
[:name [:string {:max 250}]]
[:id ::sm/uuid]])
(sv/defmethod ::update-team
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-team}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id id)
@ -503,14 +500,14 @@
nil))
(s/def ::reassign-to ::us/uuid)
(s/def ::leave-team
(s/keys :req [::rpc/profile-id]
:req-un [::id]
:opt-un [::reassign-to]))
(def ^:private schema:leave-team
[:map {:title "leave-team"}
[:id ::sm/uuid]
[:reassign-to {:optional true} ::sm/uuid]])
(sv/defmethod ::leave-team
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:leave-team}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(leave-team conn (assoc params :profile-id profile-id))))
@ -532,19 +529,20 @@
:code :non-deletable-team
:hint "impossible to delete default team"))
(wrk/submit! {::wrk/task :delete-object
::wrk/conn conn
:object :team
:deleted-at deleted-at
:id team-id})
(wrk/submit! {::db/conn conn
::wrk/task :delete-object
::wrk/params {:object :team
:deleted-at deleted-at
:id team-id}})
team))
(s/def ::delete-team
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
(def ^:private schema:delete-team
[:map {:title "delete-team"}
[:id ::sm/uuid]])
(sv/defmethod ::delete-team
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:delete-team}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id id)]
@ -557,10 +555,6 @@
;; --- Mutation: Team Update Role
(s/def ::team-id ::us/uuid)
(s/def ::member-id ::us/uuid)
(s/def ::role #{:owner :admin :editor})
;; Temporarily disabled viewer role
;; https://tree.taiga.io/project/penpot/issue/1083
(def valid-roles
@ -624,25 +618,29 @@
:profile-id member-id})
nil)))
(s/def ::update-team-member-role
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::member-id ::role]))
(def ^:private schema:update-team-member-role
[:map {:title "update-team-member-role"}
[:team-id ::sm/uuid]
[:member-id ::sm/uuid]
[:role schema:role]])
(sv/defmethod ::update-team-member-role
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-team-member-role}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(update-team-member-role conn (assoc params :profile-id profile-id))))
;; --- Mutation: Delete Team Member
(s/def ::delete-team-member
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::member-id]))
(def ^:private schema:delete-team-member
[:map {:title "delete-team-member"}
[:team-id ::sm/uuid]
[:member-id ::sm/uuid]])
(sv/defmethod ::delete-team-member
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:delete-team-member}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]
@ -665,13 +663,14 @@
(declare upload-photo)
(declare ^:private update-team-photo)
(s/def ::file ::media/upload)
(s/def ::update-team-photo
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::file]))
(def ^:private schema:update-team-photo
[:map {:title "update-team-photo"}
[:team-id ::sm/uuid]
[:file ::media/upload]])
(sv/defmethod ::update-team-photo
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-team-photo}
[cfg {:keys [::rpc/profile-id file] :as params}]
;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@ -735,12 +734,19 @@
:email email
:hint "the profile has reported repeatedly as spam or has bounces"))
;; Secondly check if the invited member email is part of the global spam/bounce report.
;; Secondly check if the invited member email is part of the global bounce report.
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email email
:hint "the email you invite has been repeatedly reported as spam or bounce"))
:hint "the email you invite has been repeatedly reported as bounce"))
;; Secondly check if the invited member email is part of the global complain report.
(when (eml/has-complaint-reports? conn email)
(ex/raise :type :restriction
:code :email-has-complaints
:email email
:hint "the email you invite has been repeatedly reported as spam"))
;; When we have email verification disabled and invitation user is
;; already present in the database, we proceed to add it to the
@ -766,6 +772,7 @@
{:id (:id member)}))
nil)
(let [id (uuid/next)
expire (dt/in-future "168h") ;; 7 days
invitation (db/exec-one! conn [sql:upsert-team-invitation id
@ -786,14 +793,16 @@
(when (contains? cf/flags :log-invitation-tokens)
(l/info :hint "invitation token" :token itoken))
(audit/submit! cfg
{::audit/type "action"
::audit/name (if updated?
"update-team-invitation"
"create-team-invitation")
::audit/profile-id (:id profile)
::audit/props (-> (dissoc tprops :profile-id)
(d/without-nils))})
(let [props (-> (dissoc tprops :profile-id)
(audit/clean-props))
evname (if updated?
"update-team-invitation"
"create-team-invitation")
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name evname)
(assoc ::audit/props props))]
(audit/submit! cfg event))
(eml/send! {::eml/conn conn
::eml/factory eml/invite-to-team
@ -809,7 +818,7 @@
(def ^:private schema:create-team-invitations
[:map {:title "create-team-invitations"}
[:team-id ::sm/uuid]
[:role [::sm/one-of #{:owner :admin :editor}]]
[:role schema:role]
[:emails ::sm/set-of-emails]])
(sv/defmethod ::create-team-invitations
@ -853,28 +862,22 @@
;; We don't re-send inviation to already existing members
(remove (partial contains? members))
(map (fn [email]
{:email email
:team team
:profile profile
:role role}))
(-> params
(assoc :email email)
(assoc :team team)
(assoc :profile profile)
(assoc :role role))))
(keep (partial create-invitation cfg)))
emails)]
(with-meta {:total (count invitations)
:invitations invitations}
{::audit/props {:invitations (count invitations)}})))))
;; --- Mutation: Create Team & Invite Members
(s/def ::emails ::us/set-of-valid-emails)
(s/def ::create-team-with-invitations
(s/merge ::create-team
(s/keys :req-un [::emails ::role])))
(def ^:private schema:create-team-with-invitations
[:map {:title "create-team-with-invitations"}
[:name :string]
[:name [:string {:max 250}]]
[:features {:optional true} ::cfeat/features]
[:id {:optional true} ::sm/uuid]
[:emails ::sm/set-of-emails]
@ -883,59 +886,62 @@
(sv/defmethod ::create-team-with-invitations
{::doc/added "1.17"
::sm/params schema:create-team-with-invitations}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
(db/with-atomic [conn pool]
[cfg {:keys [::rpc/profile-id emails role name] :as params}]
(let [features (-> (cfeat/get-enabled-features cf/flags)
(cfeat/check-client-features! (:features params)))
params (assoc params
:profile-id profile-id
:features features)
cfg (assoc cfg ::db/conn conn)
team (create-team cfg params)
profile (db/get-by-id conn :profile profile-id)
emails (into #{} (map profile/clean-email) emails)]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [features (-> (cfeat/get-enabled-features cf/flags)
(cfeat/check-client-features! (:features params)))
;; Create invitations for all provided emails.
(->> emails
(map (fn [email]
{:team team
:profile profile
:email email
:role role}))
(run! (partial create-invitation cfg)))
params (-> params
(assoc :profile-id profile-id)
(assoc :features features))
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id}
{::quotes/id ::quotes/invitations-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}
{::quotes/id ::quotes/profiles-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}))
cfg (assoc cfg ::db/conn conn)
team (create-team cfg params)
profile (db/get-by-id conn :profile profile-id)
emails (into #{} (map profile/clean-email) emails)]
(audit/submit! cfg
{::audit/type "command"
::audit/name "create-team-invitations"
::audit/profile-id profile-id
::audit/props {:emails emails
:role role
:profile-id profile-id
:invitations (count emails)}})
(let [props {:name name :features features}
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name "create-team")
(assoc ::audit/props props))]
(audit/submit! cfg event))
(vary-meta team assoc ::audit/props {:invitations (count emails)}))))
;; Create invitations for all provided emails.
(->> emails
(map (fn [email]
(-> params
(assoc :team team)
(assoc :profile profile)
(assoc :email email)
(assoc :role role))))
(run! (partial create-invitation cfg)))
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id}
{::quotes/id ::quotes/invitations-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}
{::quotes/id ::quotes/profiles-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}))
(vary-meta team assoc ::audit/props {:invitations (count emails)})))))
;; --- Query: get-team-invitation-token
(s/def ::get-team-invitation-token
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::email]))
(def ^:private schema:get-team-invitation-token
[:map {:title "get-team-invitation-token"}
[:team-id ::sm/uuid]
[:email ::sm/email]])
(sv/defmethod ::get-team-invitation-token
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:get-team-invitation-token}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
(check-read-permissions! pool profile-id team-id)
(let [email (profile/clean-email email)
@ -956,12 +962,15 @@
;; --- Mutation: Update invitation role
(s/def ::update-team-invitation-role
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::email ::role]))
(def ^:private schema:update-team-invitation-role
[:map {:title "update-team-invitation-role"}
[:team-id ::sm/uuid]
[:email ::sm/email]
[:role schema:role]])
(sv/defmethod ::update-team-invitation-role
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-team-invitation-role}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]
@ -977,12 +986,14 @@
;; --- Mutation: Delete invitation
(s/def ::delete-team-invitation
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::email]))
(def ^:private schema:delete-team-invition
[:map {:title "delete-team-invitation"}
[:team-id ::sm/uuid]
[:email ::sm/email]])
(sv/defmethod ::delete-team-invitation
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:delete-team-invition}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
(db/with-atomic [conn pool]
(let [perms (get-permissions conn profile-id team-id)]

63
backend/src/app/rpc/commands/verify_token.clj
View file

@ -7,7 +7,7 @@
(ns app.rpc.commands.verify-token
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.http.session :as session]
@ -23,21 +23,19 @@
[app.tokens :as tokens]
[app.tokens.spec.team-invitation :as-alias spec.team-invitation]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
(s/def ::iss keyword?)
(s/def ::exp ::us/inst)
[app.util.time :as dt]))
(defmulti process-token (fn [_ _ claims] (:iss claims)))
(s/def ::verify-token
(s/keys :req-un [::token]
:opt [::rpc/profile-id]))
(def ^:private schema:verify-token
[:map {:title "verify-token"}
[:token [:string {:max 1000}]]])
(sv/defmethod ::verify-token
{::rpc/auth false
::doc/added "1.15"
::doc/module :auth}
::doc/module :auth
::sm/params schema:verify-token}
[{:keys [::db/pool] :as cfg} {:keys [token] :as params}]
(db/with-atomic [conn pool]
(let [claims (tokens/verify (::setup/props cfg) {:token token})
@ -131,26 +129,28 @@
(assoc member :is-active true)))
(s/def ::spec.team-invitation/profile-id ::us/uuid)
(s/def ::spec.team-invitation/role ::us/keyword)
(s/def ::spec.team-invitation/team-id ::us/uuid)
(s/def ::spec.team-invitation/member-email ::us/email)
(s/def ::spec.team-invitation/member-id (s/nilable ::us/uuid))
(def schema:team-invitation-claims
[:map {:title "TeamInvitationClaims"}
[:iss :keyword]
[:exp ::dt/instant]
[:profile-id ::sm/uuid]
[:role teams/schema:role]
[:team-id ::sm/uuid]
[:member-email ::sm/email]
[:member-id {:optional true} ::sm/uuid]])
(s/def ::team-invitation-claims
(s/keys :req-un [::iss ::exp
::spec.team-invitation/profile-id
::spec.team-invitation/role
::spec.team-invitation/team-id
::spec.team-invitation/member-email]
:opt-un [::spec.team-invitation/member-id]))
(def valid-team-invitation-claims?
(sm/lazy-validator schema:team-invitation-claims))
(defmethod process-token :team-invitation
[{:keys [conn] :as cfg}
{:keys [::rpc/profile-id token]}
{:keys [::rpc/profile-id token] :as params}
{:keys [member-id team-id member-email] :as claims}]
(us/verify! ::team-invitation-claims claims)
(when-not (valid-team-invitation-claims? claims)
(ex/raise :type :validation
:code :invalid-invitation-token
:hint "invitation token contains unexpected data"))
(let [invitation (db/get* conn :team-invitation
{:team-id team-id :email-to member-email})
@ -169,13 +169,16 @@
;; if we have logged-in user and it matches the invitation we proceed
;; with accepting the invitation and joining the current profile to the
;; invited team.
(let [profile (accept-invitation cfg claims invitation profile)]
(-> (assoc claims :state :created)
(rph/with-meta {::audit/name "accept-team-invitation"
::audit/profile-id (:id profile)
::audit/props {:team-id (:team-id claims)
:role (:role claims)
:invitation-id (:id invitation)}})))
(let [props {:team-id (:team-id claims)
:role (:role claims)
:invitation-id (:id invitation)}
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name "accept-team-invitation")
(assoc ::audit/props props))]
(accept-invitation cfg claims invitation profile)
(audit/submit! cfg event)
(assoc claims :state :created))
(ex/raise :type :validation
:code :invalid-token

2
backend/src/app/rpc/commands/viewer.clj
View file

@ -98,7 +98,7 @@
(assoc ::perms perms)
(assoc :profile-id profile-id))]
;; When we have neither profile nor share, we just return a not
;; When we have neither profile nor share, we just return a not
;; found response to the user.
(when-not perms
(ex/raise :type :not-found

60
backend/src/app/rpc/commands/webhooks.clj
View file

@ -8,7 +8,7 @@
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[app.db :as db]
@ -19,7 +19,6 @@
[app.rpc.doc :as-alias doc]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(defn decode-row
@ -29,18 +28,6 @@
;; --- Mutation: Create Webhook
(s/def ::team-id ::us/uuid)
(s/def ::uri ::us/uri)
(s/def ::is-active ::us/boolean)
(s/def ::mtype
#{"application/json"
"application/transit+json"})
(s/def ::create-webhook
(s/keys :req [::rpc/profile-id]
:req-un [::team-id ::uri ::mtype]
:opt-un [::is-active]))
;; NOTE: for now the quote is hardcoded but this need to be solved in
;; a more universal way for handling properly object quotes
(def max-hooks-for-team 8)
@ -99,31 +86,49 @@
{::db/return-keys true})
(decode-row)))
(def valid-mtypes
#{"application/json"
"application/transit+json"})
(def ^:private schema:create-webhook
[:map {:title "create-webhook"}
[:team-id ::sm/uuid]
[:uri ::sm/uri]
[:mtype [::sm/one-of {:format "string"} valid-mtypes]]])
(sv/defmethod ::create-webhook
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:create-webhook}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
(check-edition-permissions! pool profile-id team-id)
(validate-quotes! cfg params)
(validate-webhook! cfg nil params)
(insert-webhook! cfg params))
(s/def ::update-webhook
(s/keys :req-un [::id ::uri ::mtype ::is-active]))
(def ^:private schema:update-webhook
[:map {:title "update-webhook"}
[:id ::sm/uuid]
[:uri ::sm/uri]
[:mtype [::sm/one-of {:format "string"} valid-mtypes]]
[:is-active :boolean]])
(sv/defmethod ::update-webhook
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:update-webhook}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(let [whook (-> (db/get pool :webhook {:id id}) (decode-row))]
(check-edition-permissions! pool profile-id (:team-id whook))
(validate-webhook! cfg whook params)
(update-webhook! cfg whook params)))
(s/def ::delete-webhook
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
(def ^:private schema:delete-webhook
[:map {:title "delete-webhook"}
[:id ::sm/uuid]])
(sv/defmethod ::delete-webhook
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params schema:delete-webhook}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
(db/with-atomic [conn pool]
(let [whook (-> (db/get conn :webhook {:id id}) decode-row)]
@ -133,16 +138,17 @@
;; --- Query: Webhooks
(s/def ::team-id ::us/uuid)
(s/def ::get-webhooks
(s/keys :req [::rpc/profile-id]
:req-un [::team-id]))
(def sql:get-webhooks
"select id, uri, mtype, is_active, error_code, error_count
from webhook where team_id = ? order by uri")
(def ^:private schema:get-webhooks
[:map {:title "get-webhooks"}
[:team-id ::sm/uuid]])
(sv/defmethod ::get-webhooks
{::doc/added "1.17"
::sm/params schema:get-webhooks}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)

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

@ -12,7 +12,7 @@
[app.common.spec :as us]
[clojure.spec.alpha :as s]))
(sm/def! ::permissions
(sm/register! ::permissions
[:map {:title "Permissions"}
[:type {:gen/elements [:membership :share-link]} :keyword]
[:is-owner :boolean]

12
backend/src/app/rpc/quotes.clj
View file

@ -83,17 +83,17 @@
"- Quote ID: '~(::target params)'\n"
"- Max: ~(::quote params)\n"
"- Total: ~(::total params) (INCR ~(::incr params 1))\n")]
(wrk/submit! {::wrk/task :sendmail
(wrk/submit! {::db/conn conn
::wrk/task :sendmail
::wrk/delay (dt/duration "30s")
::wrk/max-retries 4
::wrk/priority 200
::wrk/conn conn
::wrk/dedupe true
::wrk/label "quotes-notification"
:to (vec admins)
:subject subject
:body [{:type "text/plain"
:content content}]}))))
::wrk/params {:to (vec admins)
:subject subject
:body [{:type "text/plain"
:content content}]}}))))
(defn- generic-check!
[{:keys [::db/conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]

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

@ -51,12 +51,12 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.http :as-alias http]
[app.loggers.audit :refer [parse-client-ip]]
[app.redis :as rds]
[app.redis.script :as-alias rscript]
[app.rpc :as-alias rpc]
[app.rpc.helpers :as rph]
[app.rpc.rlimit.result :as-alias lresult]
[app.util.inet :as inet]
[app.util.services :as-alias sv]
[app.util.time :as dt]
[app.worker :as wrk]
@ -215,7 +215,7 @@
[{:keys [::rpc/profile-id] :as params}]
(let [request (-> params meta ::http/request)]
(or profile-id
(some-> request parse-client-ip)
(some-> request inet/parse-request)
uuid/zero)))
(defn process-request!

46
backend/src/app/srepl/fixes.clj
View file

@ -184,10 +184,7 @@
(ctk/instance-head? child))
(let [slot (guess-swap-slot component-child component-container)]
(l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot)
(ctn/update-shape container (:id child)
#(update % :touched
cfh/set-touched-group
(ctk/build-swap-slot-group slot))))
(ctn/update-shape container (:id child) #(ctk/set-swap-slot % slot)))
container)]
(recur (process-copy-head container child)
(rest children)
@ -237,3 +234,44 @@
file (-> file
(update :data process-fdata))))
(defn fix-find-duplicated-slots
[file _]
;; Find the shapes whose children have duplicated slots
(let [check-duplicate-swap-slot
(fn [shape page]
(let [shapes (map #(get (:objects page) %) (:shapes shape))
slots (->> (map #(ctk/get-swap-slot %) shapes)
(remove nil?))
counts (frequencies slots)]
#_(when (some (fn [[_ count]] (> count 1)) counts)
(l/trc :info "This shape has children with the same swap slot" :id (:id shape) :file-id (str (:id file))))
(some (fn [[_ count]] (> count 1)) counts)))
count-slots-shape
(fn [page shape]
(if (ctk/instance-root? shape)
(check-duplicate-swap-slot shape page)
false))
count-slots-page
(fn [page]
(->> (:objects page)
(vals)
(mapv #(count-slots-shape page %))
(filter true?)
count))
count-slots-data
(fn [data]
(->> (:pages-index data)
(vals)
(mapv count-slots-page)
(reduce +)))
num-missing-slots (count-slots-data (:data file))]
(when (pos? num-missing-slots)
(l/trc :info (str "Shapes with children with the same swap slot: " num-missing-slots) :file-id (str (:id file))))
file))

345
backend/src/app/srepl/main.clj
View file

@ -21,8 +21,10 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.features.components-v2 :as feat.comp-v2]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as audit]
[app.main :as main]
[app.msgbus :as mbus]
[app.rpc.commands.auth :as auth]
@ -38,10 +40,12 @@
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.java.io :as io]
[clojure.pprint :refer [print-table]]
[clojure.stacktrace :as strace]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[promesa.exec :as px]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
@ -59,32 +63,27 @@
([tname]
(run-task! tname {}))
([tname params]
(let [tasks (:app.worker/registry main/system)
tname (if (keyword? tname) (name tname) name)]
(if-let [task-fn (get tasks tname)]
(task-fn params)
(println (format "no task '%s' found" tname))))))
(wrk/invoke! (-> main/system
(assoc ::wrk/task tname)
(assoc ::wrk/params params)))))
(defn schedule-task!
([name]
(schedule-task! name {}))
([name props]
(let [pool (:app.db/pool main/system)]
(wrk/submit!
::wrk/conn pool
::wrk/task name
::wrk/props props))))
([name params]
(wrk/submit! (-> main/system
(assoc ::wrk/task name)
(assoc ::wrk/params params)))))
(defn send-test-email!
[destination]
(us/verify!
:expr (string? destination)
:hint "destination should be provided")
(let [handler (:app.email/sendmail main/system)]
(handler {:body "test email"
:subject "test email"
:to [destination]})))
(assert (string? destination) "destination should be provided")
(-> main/system
(assoc ::wrk/task :sendmail)
(assoc ::wrk/params {:body "test email"
:subject "test email"
:to [destination]})
(wrk/invoke!)))
(defn resend-email-verification-email!
[email]
@ -195,6 +194,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn notify!
"Send flash notifications.
This method allows send flash notifications to specified target destinations.
The message can be a free text or a preconfigured one.
The destination can be: all, profile-id, team-id, or a coll of them."
[{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
:or {code :generic level :info}
:as params}]
@ -202,10 +207,6 @@
["invalid level %" level]
(contains? #{:success :error :info :warning} level))
(dm/verify!
["invalid code: %" code]
(contains? #{:generic :upgrade-version} code))
(letfn [(send [dest]
(l/inf :hint "sending notification" :dest (str dest))
(let [message {:type :notification
@ -231,6 +232,9 @@
(resolve-dest [dest]
(cond
(= :all dest)
[uuid/zero]
(uuid? dest)
[dest]
@ -246,14 +250,15 @@
(mapcat resolve-dest))
dest)
(and (coll? dest)
(every? coll? dest))
(and (vector? dest)
(every? vector? dest))
(sequence (comp
(map vec)
(mapcat resolve-dest))
dest)
(vector? dest)
(and (vector? dest)
(keyword? (first dest)))
(let [[op param] dest]
(cond
(= op :email)
@ -480,6 +485,27 @@
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn delete-file!
"Mark a project for deletion"
[file-id]
(let [file-id (h/parse-uuid file-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id file-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-file!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :file
:deleted-at tnow
:id file-id})))
:deleted))
(defn- restore-file*
[{:keys [::db/conn]} file-id]
(db/update! conn :file
@ -507,22 +533,105 @@
:restored)
(defn restore-file!
"Mark a file and all related objects as not deleted"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system
(fn [system]
(when-let [file (some-> (db/get* system :file
{:id file-id}
{::db/remove-deleted false
::sql/columns [:id :name]})
(files/decode-row))]
(audit/insert! system
{::audit/name "restore-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props file
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-file!"}
::audit/tracked-at (dt/now)})
(restore-file* system file-id))))))
(defn delete-project!
"Mark a project for deletion"
[project-id]
(let [project-id (h/parse-uuid project-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id project-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-project!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :project
:deleted-at tnow
:id project-id})))
:deleted))
(defn- restore-project*
[{:keys [::db/conn] :as cfg} project-id]
(db/update! conn :project
{:deleted-at nil}
{:id project-id})
(doseq [{:keys [id]} (db/query conn :file
{:project-id project-id}
{::db/columns [:id]})]
{::sql/columns [:id]})]
(restore-file* cfg id))
:restored)
(defn restore-project!
"Mark a project and all related objects as not deleted"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system
(fn [system]
(when-let [project (db/get* system :project
{:id project-id}
{::db/remove-deleted false})]
(audit/insert! system
{::audit/name "restore-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props project
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (dt/now)})
(restore-project* system project-id))))))
(defn delete-team!
"Mark a team for deletion"
[team-id]
(let [team-id (h/parse-uuid team-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id team-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :team
:deleted-at tnow
:id team-id})))
:deleted))
(defn- restore-team*
[{:keys [::db/conn] :as cfg} team-id]
(db/update! conn :team
@ -535,49 +644,167 @@
(doseq [{:keys [id]} (db/query conn :project
{:team-id team-id}
{::db/columns [:id]})]
{::sql/columns [:id]})]
(restore-project* cfg id))
:restored)
(defn restore-deleted-team!
(defn restore-team!
"Mark a team and all related objects as not deleted"
[team-id]
(let [team-id (h/parse-uuid team-id)]
(db/tx-run! main/system restore-team* team-id)))
(db/tx-run! main/system
(fn [system]
(when-let [team (some-> (db/get* system :team
{:id team-id}
{::db/remove-deleted false})
(teams/decode-row))]
(audit/insert! system
{::audit/name "restore-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props team
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (dt/now)})
(defn restore-deleted-project!
"Mark a project and all related objects as not deleted"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system restore-project* project-id)))
(restore-team* system team-id))))))
(defn restore-deleted-file!
"Mark a file and all related objects as not deleted"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system restore-file* file-id)))
(defn delete-profile!
"Mark a profile for deletion."
[profile-id]
(let [profile-id (h/parse-uuid profile-id)
tnow (dt/now)]
(defn delete-team!
"Mark a team for deletion"
[team-id]
(let [team-id (h/parse-uuid team-id)]
(db/tx-run! main/system (fn [{:keys [::db/conn]}]
(#'teams/delete-team conn team-id)))))
(audit/insert! main/system
{::audit/name "delete-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(defn delete-project!
"Mark a project for deletion"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system (fn [{:keys [::db/conn]}]
(#'projects/delete-project conn project-id)))))
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile
:deleted-at tnow
:id profile-id})))
:deleted))
(defn delete-file!
"Mark a project for deletion"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system (fn [{:keys [::db/conn]}]
(#'files/mark-file-deleted conn file-id)))))
(defn restore-profile!
"Mark a team and all related objects as not deleted"
[profile-id]
(let [profile-id (h/parse-uuid profile-id)]
(db/tx-run! main/system
(fn [system]
(when-let [profile (some-> (db/get* system :profile
{:id profile-id}
{::db/remove-deleted false})
(profile/decode-row))]
(audit/insert! system
{::audit/name "restore-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-profile!"}
::audit/tracked-at (dt/now)})
(db/update! system :profile
{:deleted-at nil}
{:id profile-id}
{::db/return-keys false})
(doseq [{:keys [id]} (profile/get-owned-teams system profile-id)]
(restore-team* system id))
:restored)))))
(defn delete-profiles-in-bulk!
[system path]
(letfn [(process-data! [system deleted-at emails]
(loop [emails emails
deleted 0
total 0]
(if-let [email (first emails)]
(if-let [profile (db/get* system :profile
{:email (str/lower email)}
{::db/remove-deleted false})]
(do
(audit/insert! system
{::audit/name "delete-profile"
::audit/type "action"
::audit/tracked-at deleted-at
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profiles-in-bulk!"}})
(wrk/invoke! (-> system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile
:deleted-at deleted-at
:id (:id profile)})))
(recur (rest emails)
(inc deleted)
(inc total)))
(recur (rest emails)
deleted
(inc total)))
{:deleted deleted :total total})))]
(let [path (fs/path path)
deleted-at (dt/minus (dt/now) (cf/get-deletion-delay))]
(when-not (fs/exists? path)
(throw (ex-info "path does not exists" {:path path})))
(db/tx-run! system
(fn [system]
(with-open [reader (io/reader path)]
(process-data! system deleted-at (line-seq reader))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CASCADE FIXING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn process-deleted-profiles-cascade
[]
(->> (db/exec! main/system ["select id, deleted_at from profile where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile
:deleted-at deleted-at
:id id})))))))
(defn process-deleted-teams-cascade
[]
(->> (db/exec! main/system ["select id, deleted_at from team where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :team
:deleted-at deleted-at
:id id})))))))
(defn process-deleted-projects-cascade
[]
(->> (db/exec! main/system ["select id, deleted_at from project where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :project
:deleted-at deleted-at
:id id})))))))
(defn process-deleted-files-cascade
[]
(->> (db/exec! main/system ["select id, deleted_at from file where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :file
:deleted-at deleted-at
:id id})))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MISC

4
backend/src/app/storage/gc_deleted.clj
View file

@ -110,8 +110,8 @@
(defmethod ig/init-key ::handler
[_ {:keys [::min-age] :as cfg}]
(fn [params]
(let [min-age (dt/duration (or (:min-age params) min-age))]
(fn [{:keys [props] :as task}]
(let [min-age (dt/duration (or (:min-age props) min-age))]
(db/tx-run! cfg (fn [cfg]
(let [cfg (assoc cfg ::min-age min-age)
total (clean-deleted! cfg)]

72
backend/src/app/tasks/delete_object.clj
View file

@ -10,6 +10,8 @@
[app.common.logging :as l]
[app.db :as db]
[app.rpc.commands.files :as files]
[app.rpc.commands.profile :as profile]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
@ -20,8 +22,15 @@
(defmethod delete-object :file
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
(l/trc :hint "marking for deletion" :rel "file" :id (str id))
(when-let [file (db/get* conn :file {:id id} {::db/remove-deleted false})]
(l/trc :hint "marking for deletion" :rel "file" :id (str id)
:deleted-at (dt/format-instant deleted-at))
(db/update! conn :file
{:deleted-at deleted-at}
{:id id}
{::db/return-keys false})
(when (and (:is-shared file)
(not *team-deletion*))
;; NOTE: we don't prevent file deletion on absorb operation failure
@ -48,28 +57,57 @@
(defmethod delete-object :project
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
(l/trc :hint "marking for deletion" :rel "project" :id (str id))
(doseq [file (db/update! conn :file
{:deleted-at deleted-at}
{:project-id id}
{::db/return-keys [:id :deleted-at]
::db/many true})]
(delete-object cfg (assoc file :object :file))))
(l/trc :hint "marking for deletion" :rel "project" :id (str id)
:deleted-at (dt/format-instant deleted-at))
(db/update! conn :project
{:deleted-at deleted-at}
{:id id}
{::db/return-keys false})
(doseq [file (db/query conn :file
{:project-id id}
{::db/columns [:id :deleted-at]})]
(delete-object cfg (assoc file
:object :file
:deleted-at deleted-at))))
(defmethod delete-object :team
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
(l/trc :hint "marking for deletion" :rel "team" :id (str id))
(l/trc :hint "marking for deletion" :rel "team" :id (str id)
:deleted-at (dt/format-instant deleted-at))
(db/update! conn :team
{:deleted-at deleted-at}
{:id id}
{::db/return-keys false})
(db/update! conn :team-font-variant
{:deleted-at deleted-at}
{:team-id id})
{:team-id id}
{::db/return-keys false})
(binding [*team-deletion* true]
(doseq [project (db/update! conn :project
{:deleted-at deleted-at}
{:team-id id}
{::db/return-keys [:id :deleted-at]
::db/many true})]
(delete-object cfg (assoc project :object :project)))))
(doseq [project (db/query conn :project
{:team-id id}
{::db/columns [:id :deleted-at]})]
(delete-object cfg (assoc project
:object :project
:deleted-at deleted-at)))))
(defmethod delete-object :profile
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
(l/trc :hint "marking for deletion" :rel "profile" :id (str id)
:deleted-at (dt/format-instant deleted-at))
(db/update! conn :profile
{:deleted-at deleted-at}
{:id id}
{::db/return-keys false})
(doseq [team (profile/get-owned-teams conn id)]
(delete-object cfg (assoc team
:object :team
:deleted-at deleted-at))))
(defmethod delete-object :default
[_cfg props]
@ -80,5 +118,5 @@
(defmethod ig/init-key ::handler
[_ cfg]
(fn [{:keys [props] :as params}]
(fn [{:keys [props] :as task}]
(db/tx-run! cfg delete-object props)))

12
backend/src/app/tasks/file_gc.clj
View file

@ -295,17 +295,17 @@
(defmethod ig/prep-key ::handler
[_ cfg]
(assoc cfg ::min-age cf/deletion-delay))
(assoc cfg ::min-age (cf/get-deletion-delay)))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [{:keys [file-id] :as params}]
(fn [{:keys [props] :as task}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
(let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
cfg (-> cfg
(update ::sto/storage media/configure-assets-storage conn)
(assoc ::file-id file-id)
(assoc ::file-id (:file-id props))
(assoc ::min-age min-age))
total (reduce (fn [total file]
@ -314,12 +314,12 @@
0
(get-candidates cfg))]
(l/inf :hint "task finished"
(l/inf :hint "finished"
:min-age (dt/format-duration min-age)
:processed total)
;; Allow optional rollback passed by params
(when (:rollback? params)
(when (:rollback? props)
(db/rollback! conn))
{:processed total})))))

6
backend/src/app/tasks/file_xlog_gc.clj
View file

@ -29,8 +29,8 @@
(defmethod ig/init-key ::handler
[_ {:keys [::db/pool] :as cfg}]
(fn [params]
(let [min-age (or (:min-age params) (::min-age cfg))]
(fn [{:keys [props] :as task}]
(let [min-age (or (:min-age props) (::min-age cfg))]
(db/with-atomic [conn pool]
(let [interval (db/interval min-age)
result (db/exec-one! conn [sql:delete-files-xlog interval])
@ -38,7 +38,7 @@
(l/info :hint "task finished" :min-age (dt/format-duration min-age) :total result)
(when (:rollback? params)
(when (:rollback? props)
(db/rollback! conn))
result)))))

17
backend/src/app/tasks/objects_gc.clj
View file

@ -35,11 +35,6 @@
;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage))
;; And finally, permanently delete the profile. The
;; relevant objects will be deleted using DELETE
;; CASCADE database triggers. This may leave orphan
;; teams, but there is a special task for deleting
;; orphaned teams.
(db/delete! conn :profile {:id id})
(inc total))
@ -269,15 +264,15 @@
0)))
(def ^:private deletion-proc-vars
[#'delete-file-media-objects!
[#'delete-profiles!
#'delete-file-media-objects!
#'delete-file-data-fragments!
#'delete-file-object-thumbnails!
#'delete-file-thumbnails!
#'delete-files!
#'delete-projects!
#'delete-fonts!
#'delete-teams!
#'delete-profiles!])
#'delete-teams!])
(defn- execute-proc!
"A generic function that executes the specified proc iterativelly
@ -297,13 +292,13 @@
(defmethod ig/prep-key ::handler
[_ cfg]
(assoc cfg
::min-age cf/deletion-delay
::min-age (cf/get-deletion-delay)
::chunk-size 10))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [params]
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
(fn [{:keys [props] :as task}]
(let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
cfg (-> cfg
(assoc ::min-age (db/interval min-age))
(update ::sto/storage media/configure-assets-storage))]

67
backend/src/app/tasks/orphan_teams_gc.clj
View file

@ -1,67 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.tasks.orphan-teams-gc
"A maintenance task that performs orphan teams GC."
(:require
[app.common.logging :as l]
[app.db :as db]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(def ^:private sql:get-orphan-teams
"SELECT t.id
FROM team AS t
LEFT JOIN team_profile_rel AS tpr
ON (t.id = tpr.team_id)
WHERE tpr.profile_id IS NULL
AND t.deleted_at IS NULL
ORDER BY t.created_at ASC
FOR UPDATE OF t
SKIP LOCKED")
(defn- delete-orphan-teams
"Find all orphan teams (with no members) and mark them for
deletion (soft delete)."
[{:keys [::db/conn] :as cfg}]
(let [deleted-at (dt/now)]
(->> (db/cursor conn sql:get-orphan-teams)
(map :id)
(reduce (fn [total team-id]
(l/trc :hint "mark orphan team for deletion" :id (str team-id))
(db/update! conn :team
{:deleted-at deleted-at}
{:id team-id})
(wrk/submit! {::wrk/task :delete-object
::wrk/conn conn
:object :team
:deleted-at deleted-at
:id team-id})
(inc total))
0))))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [params]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(l/inf :hint "gc started" :rollback? (boolean (:rollback? params)))
(let [total (delete-orphan-teams cfg)]
(l/inf :hint "task finished"
:teams total
:rollback? (boolean (:rollback? params)))
(when (:rollback? params)
(db/rollback! conn))
{:processed total})))))

8
backend/src/app/tasks/tasks_gc.clj
View file

@ -23,12 +23,12 @@
(defmethod ig/prep-key ::handler
[_ cfg]
(assoc cfg ::min-age cf/deletion-delay))
(assoc cfg ::min-age (cf/get-deletion-delay)))
(defmethod ig/init-key ::handler
[_ {:keys [::db/pool ::min-age] :as cfg}]
(fn [params]
(let [min-age (or (:min-age params) min-age)]
(fn [{:keys [props] :as task}]
(let [min-age (or (:min-age props) min-age)]
(db/with-atomic [conn pool]
(let [interval (db/interval min-age)
result (db/exec-one! conn [sql:delete-completed-tasks interval])
@ -36,7 +36,7 @@
(l/debug :hint "task finished" :total result)
(when (:rollback? params)
(when (:rollback? props)
(db/rollback! conn))
result)))))

12
backend/src/app/tasks/telemetry.clj
View file

@ -206,14 +206,16 @@
(defmethod ig/init-key ::handler
[_ {:keys [::db/pool ::setup/props] :as cfg}]
(fn [{:keys [send? enabled?] :or {send? true enabled? false}}]
(let [subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
:newsletter-news (get-subscriptions-newsletter-news pool)}
enabled? (or enabled?
(fn [task]
(let [params (:props task)
send? (get params :send? true)
enabled? (or (get params :enabled? false)
(contains? cf/flags :telemetry)
(cf/get :telemetry-enabled))
subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
:newsletter-news (get-subscriptions-newsletter-news pool)}
data {:subscriptions subs
:version (:full cf/version)
:instance-id (:instance-id props)}]

17
backend/src/app/tokens.clj
View file

@ -8,18 +8,19 @@
"Tokens generation API."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.transit :as t]
[app.util.time :as dt]
[buddy.sign.jwe :as jwe]
[clojure.spec.alpha :as s]))
(s/def ::tokens-key bytes?)
[buddy.sign.jwe :as jwe]))
(defn generate
[{:keys [tokens-key]} claims]
(us/assert! ::tokens-key tokens-key)
(dm/assert!
"expexted token-key to be bytes instance"
(bytes? tokens-key))
(let [payload (-> claims
(assoc :iat (dt/now))
(d/without-nils)
@ -39,15 +40,13 @@
(ex/raise :type :validation
:code :invalid-token
:reason :token-expired
:params params
:claims claims))
:params params))
(when (and (contains? params :iss)
(not= (:iss claims)
(:iss params)))
(ex/raise :type :validation
:code :invalid-token
:reason :invalid-issuer
:claims claims
:params params))
claims))

37
backend/src/app/util/inet.clj Normal file
View file

@ -0,0 +1,37 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.util.inet
"INET addr parsing and validation helpers"
(:require
[cuerdas.core :as str]
[ring.request :as rreq])
(:import
com.google.common.net.InetAddresses
java.net.InetAddress))
(defn valid?
[s]
(InetAddresses/isInetAddress s))
(defn normalize
[s]
(try
(let [addr (InetAddresses/forString s)]
(.getHostAddress ^InetAddress addr))
(catch Throwable _cause
nil)))
(defn parse-request
[request]
(or (some-> (rreq/get-header request "x-real-ip")
(normalize))
(some-> (rreq/get-header request "x-forwarded-for")
(str/split #"\s*,\s*")
(first)
(normalize))
(some-> (rreq/remote-addr request)
(normalize))))

7
backend/src/app/util/objects_map.clj
View file

@ -19,7 +19,8 @@
[app.common.fressian :as fres]
[app.common.transit :as t]
[app.common.uuid :as uuid]
[clojure.core :as c])
[clojure.core :as c]
[clojure.data.json :as json])
(:import
clojure.lang.Counted
clojure.lang.IHashEq
@ -83,6 +84,10 @@
^:unsynchronized-mutable loaded?
^:unsynchronized-mutable modified?]
json/JSONWriter
(-write [this writter options]
(json/-write (into {} this) writter options))
IHashEq
(hasheq [this]
(when-not hash

41
backend/src/app/util/overrides.clj Normal file
View file

@ -0,0 +1,41 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.util.overrides
"A utility ns for declare default overrides over clojure runtime"
(:require
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[clojure.pprint :as pprint]
[datoteka.fs :as fs]))
(prefer-method print-method
clojure.lang.IRecord
clojure.lang.IDeref)
(prefer-method print-method
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(prefer-method pprint/simple-dispatch
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(sm/register! ::fs/path
{:type ::fs/path
:pred fs/path?
:type-properties
{:title "path"
:description "filesystem path"
:error/message "expected a valid fs path instance"
:error/code "errors.invalid-path"
:gen/gen (sg/generator :string)
::oapi/type "string"
::oapi/format "unix-path"
::oapi/decode fs/path}})

11
backend/src/app/util/pointer_map.clj
View file

@ -40,7 +40,8 @@
[app.common.transit :as t]
[app.common.uuid :as uuid]
[app.util.time :as dt]
[clojure.core :as c])
[clojure.core :as c]
[clojure.data.json :as json])
(:import
clojure.lang.Counted
clojure.lang.IDeref
@ -75,6 +76,14 @@
^:unsynchronized-mutable modified?
^:unsynchronized-mutable loaded?]
json/JSONWriter
(-write [this writter options]
(json/-write {:type "pointer"
:id (get-id this)
:meta (meta this)}
writter
options))
IPointerMap
(load! [_]
(when-not *load-fn*

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

@ -368,7 +368,7 @@
(let [p1 (System/nanoTime)]
#(duration {:nanos (- (System/nanoTime) p1)})))
(sm/def! ::instant
(sm/register! ::instant
{:type ::instant
:pred instant?
:type-properties
@ -379,7 +379,7 @@
::oapi/type "string"
::oapi/format "iso"}})
(sm/def! ::duration
(sm/register! ::duration
{:type :durations
:pred duration?
:type-properties

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

@ -11,7 +11,7 @@
[app.common.logging :as l]
[app.common.transit :as t]
[app.common.uuid :as uuid]
[app.loggers.audit :refer [parse-client-ip]]
[app.util.inet :as inet]
[app.util.time :as dt]
[promesa.exec :as px]
[promesa.exec.csp :as sp]
@ -84,7 +84,7 @@
output-ch (sp/chan :buf output-buff-size)
hbeat-ch (sp/chan :buf (sp/sliding-buffer 6))
close-ch (sp/chan)
ip-addr (parse-client-ip request)
ip-addr (inet/parse-request request)
uagent (rreq/get-header request "user-agent")
id (uuid/next)
state (atom {})

29
backend/src/app/worker.clj
View file

@ -8,6 +8,7 @@
"Async tasks abstraction (impl)."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid]
@ -58,17 +59,6 @@
;; SUBMIT API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- extract-props
[options]
(let [cns (namespace ::sample)]
(persistent!
(reduce-kv (fn [res k v]
(cond-> res
(not= (namespace k) cns)
(assoc! k v)))
(transient {})
options))))
(def ^:private sql:insert-new-task
"insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at)
values (?, ?, ?, ?, ?, ?, ?, now() + ?)
@ -87,14 +77,13 @@
(s/def ::task (s/or :kw keyword? :str string?))
(s/def ::queue (s/or :kw keyword? :str string?))
(s/def ::delay (s/or :int integer? :duration dt/duration?))
(s/def ::conn (s/or :pool ::db/pool :connection some?))
(s/def ::priority integer?)
(s/def ::max-retries integer?)
(s/def ::dedupe boolean?)
(s/def ::submit-options
(s/and
(s/keys :req [::task ::conn]
(s/keys :req [::task]
:opt [::label ::delay ::queue ::priority ::max-retries ::dedupe])
(fn [{:keys [::dedupe ::label] :or {label ""}}]
(if dedupe
@ -102,21 +91,23 @@
true))))
(defn submit!
[& {:keys [::task ::delay ::queue ::priority ::max-retries ::conn ::dedupe ::label]
[& {:keys [::params ::task ::delay ::queue ::priority ::max-retries ::dedupe ::label]
:or {delay 0 queue :default priority 100 max-retries 3 label ""}
:as options}]
(us/verify! ::submit-options options)
(let [duration (dt/duration delay)
interval (db/interval duration)
props (-> options extract-props db/tjson)
props (db/tjson params)
id (uuid/next)
tenant (cf/get :tenant)
task (d/name task)
queue (str/ffmt "%:%" tenant (d/name queue))
conn (db/get-connectable options)
deleted (when dedupe
(-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
:next.jdbc/update-count))]
(l/trc :hint "submit task"
:name task
:task-id (str id)
@ -126,7 +117,13 @@
:delay (dt/format-duration duration)
:replace (or deleted 0))
(db/exec-one! conn [sql:insert-new-task id task props queue
label priority max-retries interval])
id))
(defn invoke!
[{:keys [::task ::params] :as cfg}]
(assert (contains? cfg :app.worker/registry)
"missing worker registry on `cfg`")
(let [task-fn (dm/get-in cfg [:app.worker/registry (name task)])]
(task-fn {:props params})))

28
backend/test/backend_tests/helpers.clj
View file

@ -34,6 +34,7 @@
[app.util.blob :as blob]
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as wrk]
[app.worker.runner]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
@ -57,15 +58,14 @@
(def ^:dynamic *system* nil)
(def ^:dynamic *pool* nil)
(def defaults
(def default
{:database-uri "postgresql://postgres/penpot_test"
:redis-uri "redis://redis/1"
:file-change-snapshot-every 1})
:file-snapshot-every 1})
(def config
(->> (cf/read-env "penpot-test")
(merge cf/defaults defaults)
(us/conform ::cf/config)))
(cf/read-config :prefix "penpot-test"
:default (merge cf/default default)))
(def default-flags
[:enable-secure-session-cookies
@ -76,6 +76,7 @@
:enable-feature-fdata-pointer-map
:enable-feature-fdata-objets-map
:enable-feature-components-v2
:enable-file-snapshot
:disable-file-validation])
(defn state-init
@ -87,6 +88,8 @@
app.auth/verify-password (fn [a b] {:valid (= a b)})
app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)]
(cf/validate! :exit-on-error? false)
(fs/create-dir "/tmp/penpot")
(let [templates [{:id "test"
@ -103,10 +106,10 @@
(dissoc :app.srepl/server
:app.http/server
:app.http/router
:app.auth.oidc/google-provider
:app.auth.oidc/gitlab-provider
:app.auth.oidc/github-provider
:app.auth.oidc/generic-provider
:app.auth.oidc.providers/google
:app.auth.oidc.providers/gitlab
:app.auth.oidc.providers/github
:app.auth.oidc.providers/generic
:app.setup/templates
:app.auth.oidc/routes
:app.worker/monitor
@ -377,9 +380,9 @@
([name]
(run-task! name {}))
([name params]
(let [tasks (:app.worker/registry *system*)]
(let [task-fn (get tasks (d/name name))]
(task-fn params)))))
(wrk/invoke! (-> *system*
(assoc ::wrk/task name)
(assoc ::wrk/params params)))))
(def sql:pending-tasks
"select t.* from task as t
@ -523,7 +526,6 @@
([key default]
(get data key (get cf/config key default)))))
(defn reset-mock!
[m]
(swap! m (fn [m]

38
backend/test/backend_tests/loggers_webhooks_test.clj
View file

@ -21,11 +21,10 @@
(with-mocks [submit-mock {:target 'app.worker/submit! :return nil}]
(let [prof (th/create-profile* 1 {:is-active true})
res (th/run-task! :process-webhook-event
{:props
{:app.loggers.webhooks/event
{:type "command"
:name "create-project"
:props {:team-id (:default-team-id prof)}}}})]
{:event
{:type "command"
:name "create-project"
:props {:team-id (:default-team-id prof)}}})]
(t/is (= 0 (:call-count @submit-mock)))
(t/is (nil? res)))))
@ -35,11 +34,10 @@
(let [prof (th/create-profile* 1 {:is-active true})
whk (th/create-webhook* {:team-id (:default-team-id prof)})
res (th/run-task! :process-webhook-event
{:props
{:app.loggers.webhooks/event
{:type "command"
:name "create-project"
:props {:team-id (:default-team-id prof)}}}})]
{:event
{:type "command"
:name "create-project"
:props {:team-id (:default-team-id prof)}}})]
(t/is (= 1 (:call-count @submit-mock)))
(t/is (nil? res)))))
@ -52,9 +50,8 @@
:name "create-project"
:props {:team-id (:default-team-id prof)}}
res (th/run-task! :run-webhook
{:props
{:app.loggers.webhooks/event evt
:app.loggers.webhooks/config whk}})]
{:event evt
:config whk})]
(t/is (= 1 (:call-count @http-mock)))
@ -75,9 +72,8 @@
:name "create-project"
:props {:team-id (:default-team-id prof)}}
res (th/run-task! :run-webhook
{:props
{:app.loggers.webhooks/event evt
:app.loggers.webhooks/config whk}})]
{:event evt
:config whk})]
(t/is (= 1 (:call-count @http-mock)))
@ -94,14 +90,12 @@
;; RUN 2 times more
(th/run-task! :run-webhook
{:props
{:app.loggers.webhooks/event evt
:app.loggers.webhooks/config whk}})
{:event evt
:config whk})
(th/run-task! :run-webhook
{:props
{:app.loggers.webhooks/event evt
:app.loggers.webhooks/config whk}})
{:event evt
:config whk})
(let [rows (th/db-query :webhook-delivery {:webhook-id (:id whk)})]

4
backend/test/backend_tests/rpc_audit_test.clj
View file

@ -28,7 +28,8 @@
ring.request/Request
(get-header [_ name]
(case name
"x-forwarded-for" "127.0.0.44"))))
"x-forwarded-for" "127.0.0.44"
"x-real-ip" "127.0.0.43"))))
(t/deftest push-events-1
(with-redefs [app.config/flags #{:audit-log}]
@ -46,6 +47,7 @@
:profile-id (:id prof)
:timestamp (dt/now)
:type "action"}]}
params (with-meta params
{:app.http/request http-request})

58
backend/test/backend_tests/rpc_file_test.clj
View file

@ -166,6 +166,10 @@
:name "test"
:id page-id}])
;; Check the number of fragments before adding the page
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 3 (count rows))))
;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
@ -176,11 +180,11 @@
;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(t/is (= 3 (:processed res))))
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 4 (count rows))))
(t/is (= 2 (count rows))))
;; Add shape to page that should add a new fragment
(update-file!
@ -203,7 +207,7 @@
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 5 (count rows))))
(t/is (= 3 (count rows))))
;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})]
@ -211,13 +215,13 @@
;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(t/is (= 3 (:processed res))))
;; Check the number of fragments; should be 3 because changes
;; are also holding pointers to fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})]
(t/is (= 6 (count rows))))
(t/is (= 2 (count rows))))
;; Lets proceed to delete all changes
(th/db-delete! :file-change {:file-id (:id file)})
@ -233,11 +237,11 @@
;; Check the number of fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
;; (pp/pprint rows)
(t/is (= 8 (count rows)))
(t/is (= 4 (count rows)))
(t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 6 (:processed res))))
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows)))))))
@ -338,7 +342,7 @@
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(t/is (= 3 (:processed res))))
;; check file media objects
(let [rows (th/db-query :file-media-object {:file-id (:id file)})]
@ -367,7 +371,7 @@
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(t/is (= 3 (:processed res))))
;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of
@ -494,11 +498,11 @@
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})]
(t/is (= (count rows) 2)))
(t/is (= (count rows) 1)))
;; retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})]
@ -535,11 +539,11 @@
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 6 (:processed res))))
(t/is (= 7 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})]
(t/is (= (count rows) 3)))
(t/is (= (count rows) 1)))
;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of
@ -702,7 +706,7 @@
;; thumbnail lets execute the objects-gc task which remove
;; the rows and mark as touched the storage object rows
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 3 (:processed res))))
(t/is (= 5 (:processed res))))
;; Now that objects-gc have deleted the object thumbnail lets
;; execute the touched-gc task
@ -732,7 +736,7 @@
(let [res (th/run-task! :objects-gc {:min-age 0})]
;; (pp/pprint res)
(t/is (= 2 (:processed res))))
(t/is (= 3 (:processed res))))
;; We still have th storage objects in the table
(let [rows (th/db-query :storage-object {:deleted-at nil})]
@ -1127,9 +1131,9 @@
(t/is (= 1 (:processed res))))
;; check that object thumbnails are still here
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])]
;; (th/print-result! res)
(t/is (= 1 (count res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 1 (count rows))))
;; insert object snapshot for for unknown frame
(let [data {::th/type :create-file-object-thumbnail
@ -1148,22 +1152,30 @@
(th/db-exec! ["update file set has_media_trimmed=false where id=?" (:id file)])
;; check that we have all object thumbnails
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])]
(t/is (= 2 (count res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 2 (count rows))))
;; run the task again
(let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
;; check that we have all object thumbnails
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 2 (count rows))))
;; check that the unknown frame thumbnail is deleted
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 3 (:processed res))))
(t/is (= 4 (:processed res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 1 (count rows)))))))
(t/deftest file-thumbnail-ops
@ -1220,7 +1232,3 @@
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows)))))))

2
backend/test/backend_tests/rpc_file_thumbnails_test.clj
View file

@ -118,7 +118,7 @@
(t/is (= 1 (:processed result))))
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed result))))
(t/is (= 3 (:processed result))))
;; check if row2 related thumbnail row still exists
(let [[row :as rows] (th/db-query :file-tagged-object-thumbnail

254
backend/test/backend_tests/rpc_profile_test.clj
View file

@ -6,10 +6,11 @@
(ns backend-tests.rpc-profile-test
(:require
[app.auth :as auth]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.tokens :as tokens]
@ -126,7 +127,7 @@
;; (th/print-result! out)
(t/is (nil? (:error out)))))))
(t/deftest profile-deletion-simple
(t/deftest profile-deletion-1
(let [prof (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
@ -152,23 +153,22 @@
(t/is (nil? (:error out)))
(t/is (= 1 (count (:result out)))))
;; execute permanent deletion task
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(let [row (th/db-get :team
{:id (:default-team-id prof)}
{::db/remove-deleted false})]
(t/is (nil? (:deleted-at row))))
(let [result (th/run-task! :orphan-teams-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(th/run-pending-tasks!)
(let [row (th/db-get :team
{:id (:default-team-id prof)}
{::db/remove-deleted false})]
(t/is (dt/instant? (:deleted-at row))))
;; execute permanent deletion task
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 4 (:processed result))))
(let [row (th/db-get :team
{:id (:default-team-id prof)}
{::db/remove-deleted false})]
(t/is (nil? row)))
;; query profile after delete
(let [params {::th/type :get-profile
::rpc/profile-id (:id prof)}
@ -177,14 +177,187 @@
(let [result (:result out)]
(t/is (= uuid/zero (:id result)))))))
(t/deftest registration-domain-whitelist
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
(t/testing "allowed email domain"
(t/is (true? (auth/email-domain-in-whitelist? whitelist "username@ya.ru")))
(t/is (true? (auth/email-domain-in-whitelist? #{} "username@somedomain.com"))))
(t/deftest profile-deletion-2
(let [prof1 (th/create-profile* 1)
prof2 (th/create-profile* 2)
file1 (th/create-file* 1 {:profile-id (:id prof1)
:project-id (:default-project-id prof1)
:is-shared false})
team1 (th/create-team* 1 {:profile-id (:id prof1)})
(t/testing "not allowed email domain"
(t/is (false? (auth/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
role1 (th/create-team-role* {:team-id (:id team1)
:profile-id (:id prof2)
:role :editor})]
;; Assert all roles for team
(let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
(t/is (= 2 (count roles))))
;; Request profile to be deleted
(let [params {::th/type :delete-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(let [error (:error out)
edata (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type edata) :validation))
(t/is (= (:code edata) :owner-teams-with-people))))))
(t/deftest profile-deletion-3
(let [prof1 (th/create-profile* 1)
prof2 (th/create-profile* 2)
prof3 (th/create-profile* 3)
file1 (th/create-file* 1 {:profile-id (:id prof1)
:project-id (:default-project-id prof1)
:is-shared false})
team1 (th/create-team* 1 {:profile-id (:id prof1)})
role1 (th/create-team-role* {:team-id (:id team1)
:profile-id (:id prof2)
:role :editor})
role2 (th/create-team-role* {:team-id (:id team1)
:profile-id (:id prof3)
:role :editor})]
;; Assert all roles for team
(let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
(t/is (= 3 (count roles))))
;; Request profile to be deleted (it should fail)
(let [params {::th/type :delete-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(let [error (:error out)
edata (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type edata) :validation))
(t/is (= (:code edata) :owner-teams-with-people))))
;; Leave team by role 1
(let [params {::th/type :leave-team
::rpc/profile-id (:id prof2)
:id (:id team1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (nil? (:error out))))
;; Request profile to be deleted (it should fail)
(let [params {::th/type :delete-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(let [error (:error out)
edata (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type edata) :validation))
(t/is (= (:code edata) :owner-teams-with-people))))
;; Leave team by role 0 (the default) and reassing owner to role 3
;; without reassinging it (should fail)
(let [params {::th/type :leave-team
::rpc/profile-id (:id prof1)
;; :reassign-to (:id prof3)
:id (:id team1)}
out (th/command! params)]
;; (th/print-result! out)
(let [error (:error out)
edata (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type edata) :validation))
(t/is (= (:code edata) :owner-cant-leave-team))))
;; Leave team by role 0 (the default) and reassing owner to role 3
(let [params {::th/type :leave-team
::rpc/profile-id (:id prof1)
:reassign-to (:id prof3)
:id (:id team1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (nil? (:error out))))
;; Request profile to be deleted
(let [params {::th/type :delete-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (= {} (:result out)))
(t/is (nil? (:error out))))
;; query files after profile soft deletion
(let [params {::th/type :get-project-files
::rpc/profile-id (:id prof1)
:project-id (:default-project-id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= 1 (count (:result out)))))
(th/run-pending-tasks!)
;; execute permanent deletion task
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 4 (:processed result))))
(let [row (th/db-get :team
{:id (:default-team-id prof1)}
{::db/remove-deleted false})]
(t/is (nil? row)))
;; query profile after delete
(let [params {::th/type :get-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= uuid/zero (:id result)))))))
(t/deftest profile-deletion-4
(let [prof1 (th/create-profile* 1)
file1 (th/create-file* 1 {:profile-id (:id prof1)
:project-id (:default-project-id prof1)
:is-shared false})
team1 (th/create-team* 1 {:profile-id (:id prof1)})
team2 (th/create-team* 2 {:profile-id (:id prof1)})]
;; Request profile to be deleted
(let [params {::th/type :delete-profile
::rpc/profile-id (:id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (= {} (:result out)))
(t/is (nil? (:error out))))
(th/run-pending-tasks!)
(let [rows (th/db-exec! ["select id,name,deleted_at from team where deleted_at is not null"])]
(t/is (= 3 (count rows))))
;; execute permanent deletion task
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 8 (:processed result))))))
(t/deftest email-blacklist-1
(t/is (false? (email.blacklist/enabled? th/*system*)))
(t/is (true? (email.blacklist/enabled? (assoc th/*system* :app.email/blacklist []))))
(t/is (true? (email.blacklist/contains? (assoc th/*system* :app.email/blacklist #{"foo.com"}) "AA@FOO.COM"))))
(t/deftest email-whitelist-1
(t/is (false? (email.whitelist/enabled? th/*system*)))
(t/is (true? (email.whitelist/enabled? (assoc th/*system* :app.email/whitelist []))))
(t/is (true? (email.whitelist/contains? (assoc th/*system* :app.email/whitelist #{"foo.com"}) "AA@FOO.COM"))))
(t/deftest prepare-register-and-register-profile-1
(let [data {::th/type :prepare-register-profile
@ -417,9 +590,10 @@
(th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
(let [out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata)))))))
(t/deftest register-profile-with-complained-email
(let [pool (:app.db/pool th/*system*)
@ -430,9 +604,11 @@
(th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
(let [out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-complaints (:code edata)))))))
(t/deftest register-profile-with-email-as-password
(let [data {::th/type :prepare-register-profile
@ -463,20 +639,26 @@
;; with complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email data)})
(let [out (th/command! data)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-complaints (:code edata))))
(t/is (= 1 (:call-count @mock))))
;; with bounces
(th/create-global-complaint-for pool {:type :bounce :email (:email data)})
(let [out (th/command! data)
error (:error out)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :email-has-permanent-bounces))
(t/is (= 2 (:call-count @mock)))))))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata))))
(t/is (= 1 (:call-count @mock)))))))
(t/deftest email-change-request-without-smtp
@ -541,7 +723,7 @@
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
(t/is (= 1 (:call-count @mock))))
;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
@ -550,7 +732,7 @@
(t/is (nil? (:result out)))
(t/is (nil? (:error out)))
;; (th/print-result! out)
(t/is (= 2 (:call-count @mock))))))))
(t/is (= 1 (:call-count @mock))))))))
(t/deftest update-profile-password

6
backend/test/backend_tests/rpc_team_test.clj
View file

@ -62,8 +62,8 @@
(th/reset-mock! mock)
(let [data (assoc data :emails ["foo@bar.com"])
out (th/command! data)]
(t/is (th/success? out))
(t/is (= 1 (:call-count (deref mock)))))
(t/is (not (th/success? out)))
(t/is (= 0 (:call-count (deref mock)))))
;; get invitation token
(let [params {::th/type :get-team-invitation-token
@ -86,7 +86,7 @@
(t/is (= 0 (:call-count @mock)))
(let [edata (-> out :error ex-data)]
(t/is (= :validation (:type edata)))
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata)))))
;; invite internal user that is muted

2
backend/test/backend_tests/rpc_webhooks_test.clj
View file

@ -39,6 +39,8 @@
(t/is (nil? (:error out)))
(t/is (= 1 (:call-count @http-mock)))
;; (th/print-result! out)
(let [result (:result out)]
(t/is (contains? result :id))
(t/is (contains? result :team-id))

28
backend/yarn.lock
View file

@ -118,11 +118,11 @@ __metadata:
version: 0.0.0-use.local
resolution: "backend@workspace:."
dependencies:
luxon: "npm:^3.4.2"
nodemon: "npm:^3.0.1"
sax: "npm:^1.2.4"
luxon: "npm:^3.4.4"
nodemon: "npm:^3.1.2"
sax: "npm:^1.4.1"
source-map-support: "npm:^0.5.21"
ws: "npm:^8.13.0"
ws: "npm:^8.17.0"
languageName: unknown
linkType: soft
@ -573,7 +573,7 @@ __metadata:
languageName: node
linkType: hard
"luxon@npm:^3.4.2":
"luxon@npm:^3.4.4":
version: 3.4.4
resolution: "luxon@npm:3.4.4"
checksum: 10c0/02e26a0b039c11fd5b75e1d734c8f0332c95510f6a514a9a0991023e43fb233884da02d7f966823ffb230632a733fc86d4a4b1e63c3fbe00058b8ee0f8c728af
@ -745,9 +745,9 @@ __metadata:
languageName: node
linkType: hard
"nodemon@npm:^3.0.1":
version: 3.1.0
resolution: "nodemon@npm:3.1.0"
"nodemon@npm:^3.1.2":
version: 3.1.2
resolution: "nodemon@npm:3.1.2"
dependencies:
chokidar: "npm:^3.5.2"
debug: "npm:^4"
@ -761,7 +761,7 @@ __metadata:
undefsafe: "npm:^2.0.5"
bin:
nodemon: bin/nodemon.js
checksum: 10c0/3aeb50105ecae31ce4d0a5cd464011d4aa0dc15419e39ac0fd203d784e38940e1436f4ed96adbaa0f9614ee0644f91e3cf38f2afae8d3918ae7afc51c7e2116b
checksum: 10c0/7a091067d766768fb6660b796194b01748bba5dc3f1e3ed3dd5f804bfa305e207d24635755078ee5e7cc53848cea35204901e0a6e51ac64483bb8e9ecb237c95
languageName: node
linkType: hard
@ -870,10 +870,10 @@ __metadata:
languageName: node
linkType: hard
"sax@npm:^1.2.4":
version: 1.3.0
resolution: "sax@npm:1.3.0"
checksum: 10c0/599dbe0ba9d8bd55e92d920239b21d101823a6cedff71e542589303fa0fa8f3ece6cf608baca0c51be846a2e88365fac94a9101a9c341d94b98e30c4deea5bea
"sax@npm:^1.4.1":
version: 1.4.1
resolution: "sax@npm:1.4.1"
checksum: 10c0/6bf86318a254c5d898ede6bd3ded15daf68ae08a5495a2739564eb265cd13bcc64a07ab466fb204f67ce472bb534eb8612dac587435515169593f4fffa11de7c
languageName: node
linkType: hard
@ -1129,7 +1129,7 @@ __metadata:
languageName: node
linkType: hard
"ws@npm:^8.13.0":
"ws@npm:^8.17.0":
version: 8.17.0
resolution: "ws@npm:8.17.0"
peerDependencies:

18
common/deps.edn
View file

@ -1,10 +1,10 @@
{:deps
{org.clojure/clojure {:mvn/version "1.11.2"}
org.clojure/data.json {:mvn/version "2.5.0"}
org.clojure/tools.cli {:mvn/version "1.0.219"}
org.clojure/tools.cli {:mvn/version "1.1.230"}
org.clojure/clojurescript {:mvn/version "1.11.132"}
org.clojure/test.check {:mvn/version "1.1.1"}
org.clojure/data.fressian {:mvn/version "1.0.0"}
org.clojure/data.fressian {:mvn/version "1.1.0"}
;; Logging
org.apache.logging.log4j/log4j-api {:mvn/version "2.23.1"}
@ -12,14 +12,14 @@
org.apache.logging.log4j/log4j-web {:mvn/version "2.23.1"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.23.1"}
org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.23.1"}
org.slf4j/slf4j-api {:mvn/version "2.0.12"}
org.slf4j/slf4j-api {:mvn/version "2.0.13"}
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
selmer/selmer {:mvn/version "1.12.59"}
selmer/selmer {:mvn/version "1.12.61"}
criterium/criterium {:mvn/version "0.4.6"}
metosin/jsonista {:mvn/version "0.3.8"}
metosin/malli {:mvn/version "0.14.0"}
metosin/malli {:mvn/version "0.16.1"}
expound/expound {:mvn/version "0.9.0"}
com.cognitect/transit-clj {:mvn/version "1.0.333"}
@ -28,7 +28,7 @@
integrant/integrant {:mvn/version "0.8.1"}
org.apache.commons/commons-pool2 {:mvn/version "2.12.0"}
org.graalvm.js/js {:mvn/version "23.0.3"}
org.graalvm.js/js {:mvn/version "23.0.4"}
funcool/tubax {:mvn/version "2021.05.20-0"}
funcool/cuerdas {:mvn/version "2023.11.09-407"}
@ -63,7 +63,7 @@
{:dev
{:extra-deps
{org.clojure/tools.namespace {:mvn/version "RELEASE"}
thheller/shadow-cljs {:mvn/version "2.27.4"}
thheller/shadow-cljs {:mvn/version "2.28.8"}
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
criterium/criterium {:mvn/version "RELEASE"}
@ -72,12 +72,12 @@
:build
{:extra-deps
{io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
{io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
:ns-default build}
:test
{:main-opts ["-m" "kaocha.runner"]
:extra-deps {lambdaisland/kaocha {:mvn/version "1.88.1376"}}}
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
:shadow-cljs
{:main-opts ["-m" "shadow.cljs.devtools.cli"]}

10
common/package.json
View file

@ -5,19 +5,19 @@
"license": "MPL-2.0",
"author": "Kaleidos INC",
"private": true,
"packageManager": "yarn@4.2.2",
"packageManager": "yarn@4.3.1",
"repository": {
"type": "git",
"url": "https://github.com/penpot/penpot"
},
"dependencies": {
"luxon": "^3.4.2",
"sax": "^1.2.4"
"luxon": "^3.4.4",
"sax": "^1.4.1"
},
"devDependencies": {
"shadow-cljs": "2.27.4",
"shadow-cljs": "2.28.11",
"source-map-support": "^0.5.21",
"ws": "^8.13.0"
"ws": "^8.17.0"
},
"scripts": {
"fmt:clj:check": "cljfmt check --parallel=false src/ test/",

10
common/src/app/common/data.cljc
View file

@ -9,7 +9,7 @@
data resources."
(:refer-clojure :exclude [read-string hash-map merge name update-vals
parse-double group-by iteration concat mapcat
parse-uuid max min])
parse-uuid max min regexp?])
#?(:cljs
(:require-macros [app.common.data]))
@ -224,7 +224,6 @@
[coll]
(into [] (remove nil?) coll))
(defn without-nils
"Given a map, return a map removing key-value
pairs when value is `nil`."
@ -642,6 +641,13 @@
;; Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn regexp?
"Return `true` if `x` is a regexp pattern
instance."
[x]
#?(:cljs (cljs.core/regexp? x)
:clj (instance? java.util.regex.Pattern x)))
(defn nilf
"Returns a new function that if you pass nil as any argument will
return nil"

2
common/src/app/common/features.cljc
View file

@ -84,7 +84,7 @@
"plugins/runtime"}
(into frontend-only-features)))
(sm/def! ::features
(sm/register! ::features
[:schema
{:title "FileFeatures"
::smdj/inline true

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