3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-07-12 18:37:16 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #241 from tokens-studio/sync-master

Browse source 
Sync penpot master
This commit is contained in:
Florian Schrödl 2024-08-07 08:26:08 +02:00 • committed by GitHub
commit eb9b4be6ea
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
713 changed files with 33455 additions and 24268 deletions
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 # Download and cache dependencies
- restore_cache: - restore_cache:
keys: keys:
- v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}} - 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 # fallback to using the latest cache if no exact match is found
- v1-dependencies- - v1-dependencies-
- run: cd .clj-kondo && cat config.edn - run: cd .clj-kondo && cat config.edn
- run: cat .cljfmt.edn - run: cat .cljfmt.edn
@ -58,6 +58,7 @@ jobs:
command: | command: |
yarn install yarn install
yarn run fmt:clj:check yarn run fmt:clj:check
yarn run fmt:js:check
- run: - run:
name: "common linter check" name: "common linter check"
@ -107,8 +108,8 @@ jobs:
working_directory: "./frontend" working_directory: "./frontend"
command: | command: |
yarn install yarn install
yarn run compile yarn run build:app:assets
yarn run compile:cljs clojure -M:dev:shadow-cljs release main
yarn playwright install --with-deps chromium yarn playwright install --with-deps chromium
yarn e2e:test yarn e2e:test
@ -125,7 +126,6 @@ jobs:
PENPOT_TEST_REDIS_URI: "redis://localhost/1" PENPOT_TEST_REDIS_URI: "redis://localhost/1"
- save_cache: - save_cache:
paths: paths:
- ~/.m2 - ~/.m2
key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}} 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.core/-> clojure.core/-> promesa.core/-> clojure.core/->
promesa.exec.csp/go-loop clojure.core/loop promesa.exec.csp/go-loop clojure.core/loop
rumext.v2/defc clojure.core/defn
promesa.util/with-open clojure.core/with-open promesa.util/with-open clojure.core/with-open
app.common.schema.generators/let clojure.core/let app.common.schema.generators/let clojure.core/let
app.common.data/export clojure.core/def app.common.data/export clojure.core/def
@ -20,6 +19,7 @@
app.db/with-atomic hooks.export/penpot-with-atomic app.db/with-atomic hooks.export/penpot-with-atomic
potok.v2.core/reify hooks.export/potok-reify potok.v2.core/reify hooks.export/potok-reify
rumext.v2/fnc hooks.export/rumext-fnc rumext.v2/fnc hooks.export/rumext-fnc
rumext.v2/defc hooks.export/rumext-defc
rumext.v2/lazy-component hooks.export/rumext-lazycomponent rumext.v2/lazy-component hooks.export/rumext-lazycomponent
shadow.lazy/loadable 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 {})) (def registry (atom {}))
(defn potok-reify (defn potok-reify
[{:keys [:node :filename] :as params}] [{:keys [:node :filename] :as params}]
(let [[rnode rtype & other] (:children node) (let [[rnode rtype & other] (:children node)
@ -66,12 +67,86 @@
(let [[cname mdata params & body] (rest (:children node)) (let [[cname mdata params & body] (rest (:children node))
[params body] (if (api/vector-node? mdata) [params body] (if (api/vector-node? mdata)
[mdata (cons params body)] [mdata (cons params body)]
[params body])] [params body])
(let [result (api/list-node
(into [(api/token-node 'fn) result (api/list-node
params] (into [(api/token-node 'fn) params]
(cons mdata body)))] (cons mdata body)))]
{:node result})))
{: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 (defn rumext-lazycomponent

1
.cljfmt.edn
View file

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

3
.gitignore vendored
View file

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

81
CHANGES.md
View file

@ -1,6 +1,6 @@
# CHANGELOG # CHANGELOG
## 2.1.0 ## 2.2.0
### :rocket: Epics and highlights ### :rocket: Epics and highlights
@ -9,18 +9,87 @@
### :heart: Community contributions (Thank you!) ### :heart: Community contributions (Thank you!)
### :sparkles: New features ### :sparkles: New features
- Improve auth process [Taiga #Change Auth Process](https://tree.taiga.io/project/penpot/us/7094)
### :bug: Bugs fixed ### :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 ## 2.0.3
### :bug: Bugs fixed ### :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) - Fix incorrect password encoding on create-profile manage scritp [Github #3651](https://github.com/penpot/penpot/issues/3651)
## 2.0.2 ## 2.0.2
### :sparkles: Enhancements ### :sparkles: Enhancements
@ -30,7 +99,7 @@
### :bug: Bugs fixed ### :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) - 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) - 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) - 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 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.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) - [Why Penpot](#why-penpot)
- [Getting Started](#getting-started) - [Getting Started](#getting-started)
- [Community](#community) - [Community](#community)
- [Contributing](#contributing)
- [Resources](#resources) - [Resources](#resources)
- [License](#license) - [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! 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 ## Security
* Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD) * Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
* [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/) * [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
* Vaibhav Shukla * Vaibhav Shukla
* Hassan Ahmed (Alias Xen Lee)
* Michal Biesiada (@mbiesiad)
## Internationalization ## Internationalization
* [00ff88](https://hosted.weblate.org/user/00ff88) * [00ff88](https://hosted.weblate.org/user/00ff88)
* [AhmadHB](https://hosted.weblate.org/user/AhmadHB) * [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
* [Aimee](https://hosted.weblate.org/user/Aimee) * [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) * [zcraber](https://hosted.weblate.org/user/zcraber)
## Libraries & templates ## Libraries & templates
* systxema * systxema
* plumilla * plumilla
* victor crespo * victor crespo

20
backend/deps.edn
View file

@ -3,10 +3,10 @@
:deps :deps
{penpot/common {:local/root "../common"} {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"} 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 {:mvn/version "0.16.0"}
io.prometheus/simpleclient_hotspot {: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" :git/url "https://github.com/funcool/yetti.git"
:exclusions [org.slf4j/slf4j-api]} :exclusions [org.slf4j/slf4j-api]}
com.github.seancorfield/next.jdbc {:mvn/version "1.3.925"} com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
metosin/reitit-core {:mvn/version "0.6.0"} metosin/reitit-core {:mvn/version "0.7.0"}
nrepl/nrepl {:mvn/version "1.1.1"} nrepl/nrepl {:mvn/version "1.1.2"}
cider/cider-nrepl {:mvn/version "0.47.1"} cider/cider-nrepl {:mvn/version "0.48.0"}
org.postgresql/postgresql {:mvn/version "42.7.3"} 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"} com.zaxxer/HikariCP {:mvn/version "5.1.0"}
@ -58,7 +58,7 @@
;; Pretty Print specs ;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"} 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"] :paths ["src" "resources" "target/classes"]
@ -74,13 +74,13 @@
:build :build
{:extra-deps {: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} :ns-default build}
:test :test
{:main-opts ["-m" "kaocha.runner"] {:main-opts ["-m" "kaocha.runner"]
:jvm-opts ["-Dlog4j2.configurationFile=log4j2-devenv-repl.xml"] :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 :outdated
{:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}} {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}

10
backend/package.json
View file

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

2
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%"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr> <tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;"> <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> </td>
</tr> </tr>
<tr> <tr>

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

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

@ -173,7 +173,7 @@
</tr> </tr>
<tr> <tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;"> <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> </td>
</tr> </tr>
<tr> <tr>

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

@ -1,6 +1,6 @@
Hello! 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: Accept invitation using this link:

2
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%"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr> <tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;"> <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> </td>
</tr> </tr>
<tr> <tr>

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 We received a request to reset your password. Click the link below to choose a
new one: 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%"> <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
<tr> <tr>
<td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;"> <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> </td>
</tr> </tr>
<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 Thanks for signing up for your Penpot account! Please verify your email using the
link below and get started building mockups and prototypes today! 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" :name "Tutorial for beginners"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"} :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"}
{:id "lucide-icons" {:id "lucide-icons"
@ -7,12 +19,6 @@
{:id "font-awesome" {:id "font-awesome"
:name "Font Awesome" :name "Font Awesome"
:file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Font-Awesome.penpot"} :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" {:id "black-white-mobile-templates"
:name "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"} :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>WEBHOOK</span>
</span> </span>
{% endif %} {% endif %}
{% if item.params-schema-js %} {% if item.params-schema-js %}
<span class="tag"> <span class="tag">
<span>SCHEMA</span> <span>SCHEMA</span>
</span> </span>
{% endif %} {% endif %}
{% if item.spec %}
<span class="tag">
<span>SPEC</span>
</span>
{% endif %}
{% if item.sse %} {% if item.sse %}
<span class="tag"> <span class="tag">
<span>SSE</span> <span>SSE</span>

1
backend/scripts/repl
View file

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

1
backend/scripts/start-dev
View file

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

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

@ -6,9 +6,7 @@
(ns app.auth (ns app.auth
(:require (:require
[app.config :as cf] [buddy.hashers :as hashers]))
[buddy.hashers :as hashers]
[cuerdas.core :as str]))
(def default-params (def default-params
{:alg :argon2id {:alg :argon2id
@ -27,17 +25,3 @@
(catch Throwable _ (catch Throwable _
{:update false {:update false
:valid 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.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cf]
[clj-ldap.client :as ldap] [clj-ldap.client :as ldap]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.string] [clojure.string]
@ -104,17 +103,17 @@
nil)))) nil))))
(s/def ::enabled? ::us/boolean) (s/def ::enabled? ::us/boolean)
(s/def ::host ::cf/ldap-host) (s/def ::host ::us/string)
(s/def ::port ::cf/ldap-port) (s/def ::port ::us/integer)
(s/def ::ssl ::cf/ldap-ssl) (s/def ::ssl ::us/boolean)
(s/def ::tls ::cf/ldap-starttls) (s/def ::tls ::us/boolean)
(s/def ::query ::cf/ldap-user-query) (s/def ::query ::us/string)
(s/def ::base-dn ::cf/ldap-base-dn) (s/def ::base-dn ::us/string)
(s/def ::bind-dn ::cf/ldap-bind-dn) (s/def ::bind-dn ::us/string)
(s/def ::bind-password ::cf/ldap-bind-password) (s/def ::bind-password ::us/string)
(s/def ::attrs-email ::cf/ldap-attrs-email) (s/def ::attrs-email ::us/string)
(s/def ::attrs-fullname ::cf/ldap-attrs-fullname) (s/def ::attrs-fullname ::us/string)
(s/def ::attrs-username ::cf/ldap-attrs-username) (s/def ::attrs-username ::us/string)
(s/def ::provider-params (s/def ::provider-params
(s/keys :opt-un [::host ::port (s/keys :opt-un [::host ::port
@ -126,6 +125,7 @@
::attrs-email ::attrs-email
::attrs-username ::attrs-username
::attrs-fullname])) ::attrs-fullname]))
(s/def ::provider (s/def ::provider
(s/nilable ::provider-params)) (s/nilable ::provider-params))

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

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

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

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

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

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

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

@ -7,9 +7,11 @@
(ns app.email (ns app.email
"Main api for send emails." "Main api for send emails."
(:require (:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pprint :as pp] [app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
@ -149,9 +151,27 @@
"mail.smtp.timeout" timeout "mail.smtp.timeout" timeout
"mail.smtp.connectiontimeout" 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 (defn- create-smtp-session
^Session ^Session
[cfg] [cfg]
(dm/assert!
"expected valid smtp config"
(valid-smtp-config? cfg))
(let [props (opts->props cfg)] (let [props (opts->props cfg)]
(Session/getInstance props))) (Session/getInstance props)))
@ -262,44 +282,21 @@
(let [email (if factory (let [email (if factory
(factory context) (factory context)
(dissoc context ::conn))] (dissoc context ::conn))]
(wrk/submit! (merge (wrk/submit! {::wrk/task :sendmail
{::wrk/task :sendmail ::wrk/delay 0
::wrk/delay 0 ::wrk/max-retries 4
::wrk/max-retries 4 ::wrk/priority 200
::wrk/priority 200 ::db/conn conn
::wrk/conn conn} ::wrk/params email})))
email))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SENDMAIL FN / TASK HANDLER ;; 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!) (declare send-to-logger!)
(s/def ::sendmail fn?) (s/def ::sendmail fn?)
(defmethod ig/pre-init-spec ::sendmail [_]
(s/spec ::smtp-config))
(defmethod ig/init-key ::sendmail (defmethod ig/init-key ::sendmail
[_ cfg] [_ cfg]
(fn [params] (fn [params]
@ -449,3 +446,11 @@
{:email email :type "bounce"} {:email email :type "bounce"}
{:limit 10}))] {:limit 10}))]
(>= (count reports) threshold)))) (>= (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))) (partial not-found-handler request)))
(on-error [cause 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 (cond-> response
(map? body) (map? body)
(-> (update ::rres/headers assoc "content-type" "application/transit+json") (-> (update ::rres/headers assoc "content-type" "application/transit+json")
@ -151,9 +151,9 @@
[mw/params] [mw/params]
[mw/format-response] [mw/format-response]
[mw/parse-request] [mw/parse-request]
[mw/errors errors/handle]
[session/soft-auth cfg] [session/soft-auth cfg]
[actoken/soft-auth cfg] [actoken/soft-auth cfg]
[mw/errors errors/handle]
[mw/restrict-methods]]} [mw/restrict-methods]]}
(::mtx/routes cfg) (::mtx/routes cfg)

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

@ -9,6 +9,7 @@
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pprint :as pp]
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
[app.http.client :as http] [app.http.client :as http]
@ -16,10 +17,10 @@
[app.setup :as-alias setup] [app.setup :as-alias setup]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.data.json :as j]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
[jsonista.core :as j]
[promesa.exec :as px] [promesa.exec :as px]
[ring.request :as rreq] [ring.request :as rreq]
[ring.response :as-alias rres])) [ring.response :as-alias rres]))
@ -136,83 +137,110 @@
(defn- parse-json (defn- parse-json
[v] [v]
(ex/ignoring (try
(j/read-value v))) (j/read-str v)
(catch Throwable cause
(l/wrn :hint "unable to decode request body"
:cause cause))))
(defn- register-bounce-for-profile (defn- register-bounce-for-profile
[{:keys [::db/pool]} {:keys [type kind profile-id] :as report}] [{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
(when (= kind "permanent") (when (= kind "permanent")
(db/with-atomic [conn pool] (try
(db/insert! conn :profile-complaint-report (db/insert! pool :profile-complaint-report
{:profile-id profile-id {:profile-id profile-id
:type (name type) :type (name type)
:content (db/tjson report)}) :content (db/tjson report)})
;; TODO: maybe also try to find profiles by mail and if exists (catch Throwable cause
;; register profile reports for them? (l/warn :hint "unable to persist profile complaint"
(doseq [recipient (:recipients report)] :cause cause)))
(db/insert! conn :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}))] (doseq [recipient (:recipients report)]
(when (some #(= (:email profile) (:email %)) (:recipients report)) (db/insert! pool :global-complaint-report
;; If the report matches the profile email, this means that {:email (:email recipient)
;; 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
:type (name type) :type (name type)
:content (db/tjson report)})) :content (db/tjson report)}))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))] (let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report)) (when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that ;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this ;; the report is for itself, can be caused when a user
;; case just mark profile as muted (very rare case). ;; registers with an invalid email or the user email is
(db/update! conn :profile ;; 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} {: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 (defn- process-report
[cfg {:keys [type profile-id] :as report}] [cfg {:keys [type profile-id] :as report}]
(l/trace :action "processing report" :report (pr-str report))
(cond (cond
;; In this case we receive a bounce/complaint notification without ;; In this case we receive a bounce/complaint notification without
;; confirmed identity, we just emit a warning but do nothing about ;; confirmed identity, we just emit a warning but do nothing about
;; it because this is not a normal case. All notifications should ;; it because this is not a normal case. All notifications should
;; come with profile identity. ;; come with profile identity.
(nil? profile-id) (nil? profile-id)
(l/warn :msg "a notification without identity received from AWS" (l/wrn :hint "not-identified report"
:report (pr-str report)) ::l/body (pp/pprint-str report {:length 40 :level 6}))
(= "bounce" type) (= "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) (= "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 :else
(l/warn :msg "unrecognized report received from AWS" (l/wrn :hint "unrecognized report"
:report (pr-str 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 "A convencience toplevel function for gradual migration to a new API
convention." convention."
([cfg-or-client request] ([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}))) (send! client request {:sync? true})))
([cfg-or-client request options] ([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))))) (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 :as-alias http]
[app.http.access-token :as-alias actoken] [app.http.access-token :as-alias actoken]
[app.http.session :as-alias session] [app.http.session :as-alias session]
[app.util.inet :as inet]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str]
[ring.request :as rreq] [ring.request :as rreq]
[ring.response :as rres])) [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 (defn request->context
"Extracts error report relevant context data from request." "Extracts error report relevant context data from request."
[request] [request]
(let [claims (-> {} (let [claims (-> {}
(into (::session/token-claims request)) (into (::session/token-claims request))
(into (::actoken/token-claims request)))] (into (::actoken/token-claims request)))]
{:request/path (:path request) {:request/path (:path request)
:request/method (:method request) :request/method (:method request)
:request/params (:params request) :request/params (:params request)
:request/user-agent (rreq/get-header request "user-agent") :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) :request/profile-id (:uid claims)
:version/frontend (or (rreq/get-header request "x-frontend-version") "unknown") :version/frontend (or (rreq/get-header request "x-frontend-version") "unknown")
:version/backend (:full cf/version)})) :version/backend (:full cf/version)}))
(defmulti handle-error (defmulti handle-error
(fn [cause _ _] (fn [cause _ _]
(-> cause ex-data :type))) (-> cause ex-data :type)))

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

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

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

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

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

@ -21,24 +21,18 @@
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.retry :as rtry] [app.rpc.retry :as rtry]
[app.setup :as-alias setup] [app.setup :as-alias setup]
[app.util.inet :as inet]
[app.util.services :as-alias sv] [app.util.services :as-alias sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]))
[ring.request :as rreq]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS ;; 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 (defn extract-utm-params
"Extracts additional data from params and namespace them under "Extracts additional data from params and namespace them under
`penpot` ns." `penpot` ns."
@ -86,8 +80,19 @@
(remove #(contains? reserved-props (key %)))) (remove #(contains? reserved-props (key %))))
props)) 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 ;; COLLECTOR
@ -140,25 +145,31 @@
(::rpc/profile-id params) (::rpc/profile-id params)
uuid/zero) uuid/zero)
props (-> (or (::replace-props resultm) session-id (get params ::rpc/external-session-id)
(-> params event-origin (get params ::rpc/external-event-origin)
(merge (::props resultm)) props (-> (or (::replace-props resultm)
(dissoc :profile-id) (-> params
(dissoc :type))) (merge (::props resultm))
(dissoc :profile-id)
(dissoc :type)))
(clean-props)) (clean-props))
token-id (::actoken/id request) token-id (::actoken/id request)
context (-> (::context resultm) context (-> (::context resultm)
(assoc :external-session-id session-id)
(assoc :external-event-origin event-origin)
(assoc :access-token-id (some-> token-id str)) (assoc :access-token-id (some-> token-id str))
(d/without-nils))] (d/without-nils))
ip-addr (inet/parse-request request)]
{::type (or (::type resultm) {::type (or (::type resultm)
(::rpc/type cfg)) (::rpc/type cfg))
::name (or (::name resultm) ::name (or (::name resultm)
(::sv/name mdata)) (::sv/name mdata))
::profile-id profile-id ::profile-id profile-id
::ip-addr (some-> request parse-client-ip) ::ip-addr ip-addr
::props props ::props props
::context context ::context context
@ -180,15 +191,33 @@
(::webhooks/event? resultm) (::webhooks/event? resultm)
false)})) false)}))
(defn- handle-event! (defn- event->params
[cfg event] [event]
(let [params {:id (uuid/next) (let [params {:id (uuid/next)
:name (::name event) :name (::name event)
:type (::type event) :type (::type event)
:profile-id (::profile-id event) :profile-id (::profile-id event)
:ip-addr (::ip-addr event) :ip-addr (::ip-addr event)
:context (::context event) :context (::context event {})
:props (::props 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)] tnow (dt/now)]
(when (contains? cf/flags :audit-log) (when (contains? cf/flags :audit-log)
@ -197,12 +226,8 @@
;; this case we just retry the operation. ;; this case we just retry the operation.
(let [params (-> params (let [params (-> params
(assoc :created-at tnow) (assoc :created-at tnow)
(assoc :tracked-at tnow) (update :tracked-at #(or % tnow)))]
(update :props db/tjson) (append-audit-entry! cfg params)))
(update :context db/tjson)
(update :ip-addr db/inet)
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(when (and (or (contains? cf/flags :telemetry) (when (and (or (contains? cf/flags :telemetry)
(cf/get :telemetry-enabled)) (cf/get :telemetry-enabled))
@ -214,12 +239,10 @@
;; NOTE: this is only executed when general audit log is disabled ;; NOTE: this is only executed when general audit log is disabled
(let [params (-> params (let [params (-> params
(assoc :created-at tnow) (assoc :created-at tnow)
(assoc :tracked-at tnow) (update :tracked-at #(or % tnow))
(assoc :props (db/tjson {})) (assoc :props {})
(assoc :context (db/tjson {})) (assoc :context {}))]
(assoc :ip-addr (db/inet "0.0.0.0")) (append-audit-entry! cfg params)))
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(when (and (contains? cf/flags :webhooks) (when (and (contains? cf/flags :webhooks)
(::webhooks/event? event)) (::webhooks/event? event))
@ -232,25 +255,23 @@
:else label) :else label)
dedupe? (boolean (and batch-key batch-timeout))] dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! ::wrk/conn (::db/conn cfg) (wrk/submit! (-> cfg
::wrk/task :process-webhook-event (assoc ::wrk/task :process-webhook-event)
::wrk/queue :webhooks (assoc ::wrk/queue :webhooks)
::wrk/max-retries 0 (assoc ::wrk/max-retries 0)
::wrk/delay (or batch-timeout 0) (assoc ::wrk/delay (or batch-timeout 0))
::wrk/dedupe dedupe? (assoc ::wrk/dedupe dedupe?)
::wrk/label label (assoc ::wrk/label label)
(assoc ::wrk/params (-> params
::webhooks/event (dissoc :ip-addr)
(-> params (dissoc :type)))))))
(dissoc :ip-addr)
(dissoc :type)))))
params)) params))
(defn submit! (defn submit!
"Submit audit event to the collector." "Submit audit event to the collector."
[cfg params] [cfg event]
(try (try
(let [event (d/without-nils params) (let [event (d/without-nils event)
cfg (-> cfg cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?) (assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6) (assoc ::rtry/max-retries 6)
@ -259,3 +280,18 @@
(rtry/invoke! cfg db/tx-run! handle-event! event)) (rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable cause (catch Throwable cause
(l/error :hint "unexpected error processing event" :cause 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])) (s/keys :req [::db/pool]))
(defmethod ig/init-key ::process-event-handler (defmethod ig/init-key ::process-event-handler
[_ {:keys [::db/pool] :as cfg}] [_ cfg]
(fn [{:keys [props] :as task}] (fn [{:keys [props] :as task}]
(let [event (::event props)] (let [event (:event props)]
(l/dbg :hint "process webhook event" :name (:name event)) (l/dbg :hint "process webhook event" :name (:name event))
(when-let [items (lookup-webhooks cfg event)] (when-let [items (lookup-webhooks cfg event)]
(l/trc :hint "webhooks found for event" :total (count items)) (l/trc :hint "webhooks found for event" :total (count items))
(db/with-atomic [conn pool] (db/tx-run! cfg (fn [cfg]
(doseq [item items] (doseq [item items]
(wrk/submit! ::wrk/conn conn (wrk/submit! (-> cfg
::wrk/task :run-webhook (assoc ::wrk/task :run-webhook)
::wrk/queue :webhooks (assoc ::wrk/queue :webhooks)
::wrk/max-retries 3 (assoc ::wrk/max-retries 3)
::event event (assoc ::wrk/params {:event event
::config item))))))) :config item}))))))))))
;; --- RUN ;; --- RUN
@ -128,8 +128,8 @@
:rsp-data (db/tjson rsp)}))] :rsp-data (db/tjson rsp)}))]
(fn [{:keys [props] :as task}] (fn [{:keys [props] :as task}]
(let [event (::event props) (let [event (:event props)
whook (::config props) whook (:config props)
body (case (:mtype whook) body (case (:mtype whook)
"application/json" (json/write-str event json-write-opts) "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/name "penpot_tasks_timing"
::mdef/help "Background tasks timing (milliseconds)." ::mdef/help "Background tasks timing (milliseconds)."
::mdef/labels ["name"] ::mdef/labels ["name"]
::mdef/type :summary} ::mdef/type :histogram}
:redis-eval-timing :redis-eval-timing
{::mdef/name "penpot_redis_eval_timing" {::mdef/name "penpot_redis_eval_timing"
::mdef/help "Redis EVAL commands execution timings (ms)" ::mdef/help "Redis EVAL commands execution timings (ms)"
::mdef/labels ["name"] ::mdef/labels ["name"]
::mdef/type :summary} ::mdef/type :histogram}
:rpc-climit-queue :rpc-climit-queue
{::mdef/name "penpot_rpc_climit_queue" {::mdef/name "penpot_rpc_climit_queue"
@ -126,7 +126,7 @@
{::mdef/name "penpot_rpc_climit_timing" {::mdef/name "penpot_rpc_climit_timing"
::mdef/help "Summary of the time between queuing and executing on the CLIMIT" ::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
::mdef/labels ["name"] ::mdef/labels ["name"]
::mdef/type :summary} ::mdef/type :histogram}
:audit-http-handler-queue-size :audit-http-handler-queue-size
{::mdef/name "penpot_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/name "penpot_audit_http_handler_timing"
::mdef/help "Summary of the time between queuing and executing on the audit log http handler" ::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
::mdef/labels [] ::mdef/labels []
::mdef/type :summary} ::mdef/type :histogram}
:executors-active-threads :executors-active-threads
{::mdef/name "penpot_executors_active_threads" {::mdef/name "penpot_executors_active_threads"
@ -254,7 +254,7 @@
{::http.client/client (ig/ref ::http.client/client)} {::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/gitlab ::oidc.providers/gitlab
{} {::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/generic ::oidc.providers/generic
{::http.client/client (ig/ref ::http.client/client)} {::http.client/client (ig/ref ::http.client/client)}
@ -267,7 +267,9 @@
:github (ig/ref ::oidc.providers/github) :github (ig/ref ::oidc.providers/github)
:gitlab (ig/ref ::oidc.providers/gitlab) :gitlab (ig/ref ::oidc.providers/gitlab)
:oidc (ig/ref ::oidc.providers/generic)} :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 :app.http/router
{::session/manager (ig/ref ::session/manager) {::session/manager (ig/ref ::session/manager)
@ -322,7 +324,10 @@
::rpc/climit (ig/ref ::rpc/climit) ::rpc/climit (ig/ref ::rpc/climit)
::rpc/rlimit (ig/ref ::rpc/rlimit) ::rpc/rlimit (ig/ref ::rpc/rlimit)
::setup/templates (ig/ref ::setup/templates) ::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 :app.rpc.doc/routes
{:methods (ig/ref :app.rpc/methods)} {:methods (ig/ref :app.rpc/methods)}
@ -338,7 +343,6 @@
::wrk/tasks ::wrk/tasks
{:sendmail (ig/ref ::email/handler) {:sendmail (ig/ref ::email/handler)
:objects-gc (ig/ref :app.tasks.objects-gc/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-gc (ig/ref :app.tasks.file-gc/handler)
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler) :file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler) :tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
@ -356,6 +360,12 @@
:run-webhook :run-webhook
(ig/ref ::webhooks/run-webhook-handler)}} (ig/ref ::webhooks/run-webhook-handler)}}
::email/blacklist
{}
::email/whitelist
{}
::email/sendmail ::email/sendmail
{::email/host (cf/get :smtp-host) {::email/host (cf/get :smtp-host)
::email/port (cf/get :smtp-port) ::email/port (cf/get :smtp-port)
@ -377,9 +387,6 @@
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)} ::sto/storage (ig/ref ::sto/storage)}
:app.tasks.orphan-teams-gc/handler
{::db/pool (ig/ref ::db/pool)}
:app.tasks.delete-object/handler :app.tasks.delete-object/handler
{::db/pool (ig/ref ::db/pool)} {::db/pool (ig/ref ::db/pool)}
@ -468,9 +475,6 @@
{:cron #app/cron "0 0 0 * * ?" ;; daily {:cron #app/cron "0 0 0 * * ?" ;; daily
:task :objects-gc} :task :objects-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily
:task :orphan-teams-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily {:cron #app/cron "0 0 0 * * ?" ;; daily
:task :storage-gc-deleted} :task :storage-gc-deleted}
@ -520,6 +524,7 @@
(defn start (defn start
[] []
(cf/validate!)
(ig/load-namespaces (merge system-config worker-config)) (ig/load-namespaces (merge system-config worker-config))
(alter-var-root #'system (fn [sys] (alter-var-root #'system (fn [sys]
(when sys (ig/halt! 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.exceptions :as ex]
[app.common.media :as cm] [app.common.media :as cm]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi] [app.common.schema.openapi :as-alias oapi]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.svg :as csvg] [app.common.svg :as csvg]
@ -47,19 +46,7 @@
(s/keys :req-un [::path] (s/keys :req-un [::path]
:opt-un [::mtype])) :opt-un [::mtype]))
(sm/def! ::fs/path (sm/register! ::upload
{: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
[:map {:title "Upload"} [:map {:title "Upload"}
[:filename :string] [:filename :string]
[:size :int] [:size :int]

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

@ -29,6 +29,7 @@
[app.rpc.rlimit :as rlimit] [app.rpc.rlimit :as rlimit]
[app.setup :as-alias setup] [app.setup :as-alias setup]
[app.storage :as-alias sto] [app.storage :as-alias sto]
[app.util.inet :as inet]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -70,6 +71,22 @@
(handle-response-transformation request mdata) (handle-response-transformation request mdata)
(handle-before-comple-hook 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 (defn- rpc-handler
"Ring handler that dispatches cmd requests and convert between "Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow." internal async flow into ring async flow."
@ -79,8 +96,16 @@
profile-id (or (::session/profile-id request) profile-id (or (::session/profile-id request)
(::actoken/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 data (-> params
(assoc ::handler-name handler-name)
(assoc ::ip-addr ip-addr)
(assoc ::request-at (dt/now)) (assoc ::request-at (dt/now))
(assoc ::external-session-id session-id)
(assoc ::external-event-origin event-origin)
(assoc ::session/id (::session/id request)) (assoc ::session/id (::session/id request))
(assoc ::cond/key etag) (assoc ::cond/key etag)
(cond-> (uuid? profile-id) (cond-> (uuid? profile-id)
@ -188,10 +213,10 @@
(defn- wrap-all (defn- wrap-all
[cfg f mdata] [cfg f mdata]
(as-> f $ (as-> f $
(wrap-metrics cfg $ mdata)
(cond/wrap cfg $ mdata) (cond/wrap cfg $ mdata)
(retry/wrap-retry cfg $ mdata) (retry/wrap-retry cfg $ mdata)
(climit/wrap cfg $ mdata) (climit/wrap cfg $ mdata)
(wrap-metrics cfg $ mdata)
(rlimit/wrap cfg $ mdata) (rlimit/wrap cfg $ mdata)
(wrap-audit cfg $ mdata) (wrap-audit cfg $ mdata)
(wrap-spec-conform 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 (ns app.rpc.commands.access-token
(:require (:require
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.main :as-alias main] [app.main :as-alias main]
@ -16,8 +16,7 @@
[app.setup :as-alias setup] [app.setup :as-alias setup]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]))
[clojure.spec.alpha :as s]))
(defn- decode-row (defn- decode-row
[row] [row]
@ -44,7 +43,7 @@
:perms (db/create-array conn "text" [])}))) :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] [{:keys [::db/pool] :as system} profile-id name expiration]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [props (:app.setup/props system)] (let [props (:app.setup/props system)]
@ -53,16 +52,14 @@
name name
expiration)))) expiration))))
(s/def ::name ::us/not-empty-string) (def ^:private schema:create-access-token
(s/def ::expiration ::dt/duration) [:map {:title "create-access-token"}
[:name [:string {:max 250 :min 1}]]
(s/def ::create-access-token [:expiration {:optional true} ::dt/duration]])
(s/keys :req [::rpc/profile-id]
:req-un [::name]
:opt-un [::expiration]))
(sv/defmethod ::create-access-token (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]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name expiration]}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [cfg (assoc cfg ::db/conn conn)] (let [cfg (assoc cfg ::db/conn conn)]
@ -72,21 +69,23 @@
(-> (create-access-token cfg profile-id name expiration) (-> (create-access-token cfg profile-id name expiration)
(decode-row))))) (decode-row)))))
(s/def ::delete-access-token (def ^:private schema:delete-access-token
(s/keys :req [::rpc/profile-id] [:map {:title "delete-access-token"}
:req-un [::us/id])) [:id ::sm/uuid]])
(sv/defmethod ::delete-access-token (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]}] [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
(db/delete! pool :access-token {:id id :profile-id profile-id}) (db/delete! pool :access-token {:id id :profile-id profile-id})
nil) nil)
(s/def ::get-access-tokens (def ^:private schema:get-access-tokens
(s/keys :req [::rpc/profile-id])) [:map {:title "get-access-tokens"}])
(sv/defmethod ::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]}] [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
(->> (db/query pool :access-token (->> (db/query pool :access-token
{:profile-id profile-id} {:profile-id profile-id}

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

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

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

@ -6,7 +6,6 @@
(ns app.rpc.commands.auth (ns app.rpc.commands.auth
(:require (:require
[app.auth :as auth]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
@ -17,6 +16,8 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.email :as eml] [app.email :as eml]
[app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
@ -37,13 +38,11 @@
(def schema:token (def schema:token
[::sm/word-string {:max 6000}]) [::sm/word-string {:max 6000}])
(def ^:private default-verify-threshold
(dt/duration "15m"))
(defn- elapsed-verify-threshold? (defn- elapsed-verify-threshold?
[profile] [profile]
(let [elapsed (dt/diff (:modified-at profile) (dt/now))] (let [elapsed (dt/diff (:modified-at profile) (dt/now))
(pos? (compare elapsed default-verify-threshold)))) verify-threshold (cf/get :email-verify-threshold)]
(pos? (compare elapsed verify-threshold))))
;; ---- COMMAND: login with password ;; ---- COMMAND: login with password
@ -129,12 +128,21 @@
;; ---- COMMAND: Logout ;; ---- COMMAND: Logout
(def ^:private schema:logout
[:map {:title "logoug"}
[:profile-id {:optional true} ::sm/uuid]])
(sv/defmethod ::logout (sv/defmethod ::logout
"Clears the authentication cookie and logout the current session." "Clears the authentication cookie and logout the current session."
{::rpc/auth false {::rpc/auth false
::doc/added "1.15"} ::doc/changes [["2.1" "Now requires profile-id passed in the body"]]
[cfg _] ::doc/added "1.0"
(rph/with-transform {} (session/delete-fn cfg))) ::sm/params schema:logout}
[cfg params]
(if (= (:profile-id params)
(::rpc/profile-id params))
(rph/with-transform {} (session/delete-fn cfg))
{}))
;; ---- COMMAND: Recover Profile ;; ---- COMMAND: Recover Profile
@ -186,8 +194,14 @@
:code :email-does-not-match-invitation :code :email-does-not-match-invitation
:hint "email should match the invitation")))) :hint "email should match the invitation"))))
(when-not (auth/email-domain-in-whitelist? (:email params)) (when (and (email.blacklist/enabled? cfg)
(ex/raise :type :validation (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)) :code :email-domain-is-not-allowed))
;; Perform a basic validation of email & password ;; Perform a basic validation of email & password
@ -195,7 +209,19 @@
(str/lower (:password params))) (str/lower (:password params)))
(ex/raise :type :validation (ex/raise :type :validation
:code :email-as-password :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 (defn prepare-register
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}] [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
@ -272,14 +298,17 @@
(try (try
(-> (db/insert! conn :profile params) (-> (db/insert! conn :profile params)
(profile/decode-row)) (profile/decode-row))
(catch org.postgresql.util.PSQLException e (catch org.postgresql.util.PSQLException cause
(let [state (.getSQLState e)] (let [state (.getSQLState cause)]
(if (not= state "23505") (if (not= state "23505")
(throw e) (throw cause)
(ex/raise :type :validation
:code :email-already-exists (do
:hint "email already exists" (l/error :hint "not an error" :cause cause)
:cause e))))))) (ex/raise :type :validation
:code :email-already-exists
:hint "email already exists"
:cause cause))))))))
(defn create-profile-rels! (defn create-profile-rels!
[conn {:keys [id] :as profile}] [conn {:keys [id] :as profile}]
@ -326,7 +355,7 @@
profile (if-let [profile-id (:profile-id claims)] profile (if-let [profile-id (:profile-id claims)]
(profile/get-profile conn profile-id) (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))) (not (contains? cf/flags :email-verification)))
params (-> params params (-> params
(assoc :is-active is-active) (assoc :is-active is-active)
@ -334,6 +363,9 @@
(->> (create-profile! conn params) (->> (create-profile! conn params)
(create-profile-rels! conn)))) (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)] invitation (when-let [token (:invitation-token params)]
(tokens/verify (::setup/props cfg) {:token token :iss :team-invitation})) (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 ;; When a new user is created and it is already activated by
;; configuration or specified by OIDC, we just mark the profile ;; configuration or specified by OIDC, we just mark the profile
;; as logged-in ;; as logged-in
(not (:profile-id claims)) created?
(if (:is-active claims) (if (:is-active profile)
(-> (profile/strip-private-attrs profile) (-> (profile/strip-private-attrs profile)
(rph/with-transform (session/create-fn cfg (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta (rph/with-meta
@ -381,20 +413,22 @@
::audit/profile-id (:id profile)})) ::audit/profile-id (:id profile)}))
(do (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)} (rph/with-meta {:email (:email profile)}
{::audit/replace-props props {::audit/replace-props props
::audit/context {:action "email-verification"} ::audit/context {:action "email-verification"}
::audit/profile-id (:id profile)}))) ::audit/profile-id (:id profile)})))
:else :else
(let [elapsed? (elapsed-verify-threshold? profile) (let [elapsed? (elapsed-verify-threshold? profile)
bounce? (eml/has-bounce-reports? conn (:email profile)) complaints? (eml/has-reports? conn (:email profile))
action (if bounce? action (if complaints?
"ignore-because-bounce" "ignore-because-complaints"
(if elapsed? (if elapsed?
"resend-email-verification" "resend-email-verification"
"ignore"))] "ignore"))]
(l/wrn :hint "repeated registry detected" (l/wrn :hint "repeated registry detected"
:profile-id (str (:id profile)) :profile-id (str (:id profile))
@ -423,15 +457,13 @@
::doc/added "1.15" ::doc/added "1.15"
::sm/params schema:register-profile ::sm/params schema:register-profile
::climit/id :auth/global} ::climit/id :auth/global}
[{:keys [::db/pool] :as cfg} params] [cfg params]
(db/with-atomic [conn pool] (db/tx-run! cfg register-profile params))
(-> (assoc cfg ::db/conn conn)
(register-profile params))))
;; ---- COMMAND: Request Profile Recovery ;; ---- COMMAND: Request Profile Recovery
(defn- 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}] (letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (::setup/props cfg) (let [token (tokens/generate (::setup/props cfg)
{:iss :password-recovery {:iss :password-recovery
@ -453,39 +485,42 @@
:extra-data ptoken}) :extra-data ptoken})
nil))] nil))]
(db/with-atomic [conn pool] (let [profile (->> (profile/clean-email email)
(let [profile (->> (profile/clean-email email) (profile/get-profile-by-email conn))]
(profile/get-profile-by-email conn))]
(cond (cond
(not profile) (not profile)
(l/wrn :hint "attempt of profile recovery: no profile found" (l/wrn :hint "attempt of profile recovery: no profile found"
:profile-email email) :profile-email email)
(not (eml/allow-send-emails? conn profile)) (not (eml/allow-send-emails? conn profile))
(l/wrn :hint "attempt of profile recovery: profile is muted" (l/wrn :hint "attempt of profile recovery: profile is muted"
:profile-id (str (:id profile)) :profile-id (str (:id profile))
:profile-email (:email profile)) :profile-email (:email profile))
(eml/has-bounce-reports? conn (:email profile)) (eml/has-bounce-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has bounces" (l/wrn :hint "attempt of profile recovery: email has bounces"
:profile-id (str (:id profile)) :profile-id (str (:id profile))
:profile-email (:email profile)) :profile-email (:email profile))
(not (elapsed-verify-threshold? profile)) (eml/has-complaint-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed" (l/wrn :hint "attempt of profile recovery: email has complaints"
:profile-id (str (:id profile)) :profile-id (str (:id profile))
:profile-email (:email 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 :else
(do (do
(db/update! conn :profile (db/update! conn :profile
{:modified-at (dt/now)} {:modified-at (dt/now)}
{:id (:id profile)}) {:id (:id profile)})
(->> profile (->> profile
(create-recovery-token) (create-recovery-token)
(send-email-notification conn)))))))) (send-email-notification conn)))))))
(def schema:request-profile-recovery (def schema:request-profile-recovery
@ -497,6 +532,6 @@
::doc/added "1.15" ::doc/added "1.15"
::sm/params schema:request-profile-recovery} ::sm/params schema:request-profile-recovery}
[cfg params] [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 (def ^:private
schema:export-binfile schema:export-binfile
(sm/define [:map {:title "export-binfile"}
[:map {:title "export-binfile"} [:name [:string {:max 250}]]
[:name :string] [:file-id ::sm/uuid]
[:file-id ::sm/uuid] [:include-libraries :boolean]
[:include-libraries :boolean] [:embed-assets :boolean]])
[:embed-assets :boolean]]))
(sv/defmethod ::export-binfile (sv/defmethod ::export-binfile
"Export a penpot file in a binary format." "Export a penpot file in a binary format."
@ -78,11 +77,10 @@
(def ^:private (def ^:private
schema:import-binfile schema:import-binfile
(sm/define [:map {:title "import-binfile"}
[:map {:title "import-binfile"} [:name [:string {:max 250}]]
[:name :string] [:project-id ::sm/uuid]
[:project-id ::sm/uuid] [:file ::media/upload]])
[:file ::media/upload]]))
(sv/defmethod ::import-binfile (sv/defmethod ::import-binfile
"Import a penpot file in a binary format." "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"} [:map {:title "create-comment-thread"}
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:position ::gpt/point] [:position ::gpt/point]
[:content :string] [:content [:string {:max 250}]]
[:page-id ::sm/uuid] [:page-id ::sm/uuid]
[:frame-id ::sm/uuid] [:frame-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]]) [:share-id {:optional true} [:maybe ::sm/uuid]]])
@ -418,7 +418,7 @@
schema:create-comment schema:create-comment
[:map {:title "create-comment"} [:map {:title "create-comment"}
[:thread-id ::sm/uuid] [:thread-id ::sm/uuid]
[:content :string] [:content [:string {:max 250}]]
[:share-id {:optional true} [:maybe ::sm/uuid]]]) [:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::create-comment (sv/defmethod ::create-comment
@ -477,7 +477,7 @@
schema:update-comment schema:update-comment
[:map {:title "update-comment"} [:map {:title "update-comment"}
[:id ::sm/uuid] [:id ::sm/uuid]
[:content :string] [:content [:string {:max 250}]]
[:share-id {:optional true} [:maybe ::sm/uuid]]]) [:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment (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.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
[buddy.core.nonce :as bn] [buddy.core.nonce :as bn]))
[clojure.spec.alpha :as s]))
(s/def ::create-demo-profile any?)
(sv/defmethod ::create-demo-profile (sv/defmethod ::create-demo-profile
"A command that is responsible of creating a demo purpose "A command that is responsible of creating a demo purpose
@ -48,7 +45,7 @@
params {:email email params {:email email
:fullname fullname :fullname fullname
:is-active true :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) :password (profile/derive-password cfg password)
:props {}}] :props {}}]

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

@ -8,29 +8,25 @@
"A general purpose feedback module." "A general purpose feedback module."
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.schema :as sm]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.email :as eml] [app.email :as eml]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.util.services :as sv] [app.util.services :as sv]))
[clojure.spec.alpha :as s]))
(declare ^:private send-feedback!) (declare ^:private send-feedback!)
(s/def ::content ::us/string) (def ^:private schema:send-user-feedback
(s/def ::from ::us/email) [:map {:title "send-user-feedback"}
(s/def ::subject ::us/string) [:subject [:string {:max 250}]]
[:content [:string {:max 250}]]])
(s/def ::send-user-feedback
(s/keys :req [::rpc/profile-id]
:req-un [::subject
::content]))
(sv/defmethod ::send-user-feedback (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}] [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
(when-not (contains? cf/flags :user-feedback) (when-not (contains? cf/flags :user-feedback)
(ex/raise :type :restriction (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.logging :as l]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj] [app.common.schema.desc-js-like :as-alias smdj]
[app.common.spec :as us]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.config :as cf] [app.config :as cf]
@ -36,7 +35,6 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str])) [cuerdas.core :as str]))
;; --- FEATURES ;; --- FEATURES
@ -46,18 +44,6 @@
(when media-id (when media-id
(str (cf/get :public-uri) "/assets/by-id/" 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 ;; --- HELPERS
(def long-cache-duration (def long-cache-duration
@ -191,7 +177,7 @@
[:features ::cfeat/features] [:features ::cfeat/features]
[:has-media-trimmed :boolean] [:has-media-trimmed :boolean]
[:comment-thread-seqn {:min 0} :int] [:comment-thread-seqn {:min 0} :int]
[:name :string] [:name [:string {:max 250}]]
[:revn {:min 0} :int] [:revn {:min 0} :int]
[:modified-at ::dt/instant] [:modified-at ::dt/instant]
[:is-shared :boolean] [:is-shared :boolean]
@ -671,7 +657,7 @@
f.modified_at, f.modified_at,
f.name, f.name,
f.is_shared, f.is_shared,
ft.media_id, ft.media_id AS thumbnail_id,
row_number() over w as row_num row_number() over w as row_num
from file as f from file as f
inner join project as p on (p.id = f.project_id) inner join project as p on (p.id = f.project_id)
@ -690,10 +676,8 @@
[conn team-id] [conn team-id]
(->> (db/exec! conn [sql:team-recent-files team-id]) (->> (db/exec! conn [sql:team-recent-files team-id])
(mapv (fn [row] (mapv (fn [row]
(if-let [media-id (:media-id row)] (if-let [media-id (:thumbnail-id row)]
(-> row (assoc row :thumbnail-uri (resolve-public-uri media-id))
(dissoc :media-id)
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(dissoc row :media-id)))))) (dissoc row :media-id))))))
(def ^:private schema:get-team-recent-files (def ^:private schema:get-team-recent-files
@ -761,19 +745,19 @@
[:map {:title "RenameFileEvent"} [:map {:title "RenameFileEvent"}
[:id ::sm/uuid] [:id ::sm/uuid]
[:project-id ::sm/uuid] [:project-id ::sm/uuid]
[:name :string] [:name [:string {:max 250}]]
[:created-at ::dt/instant] [:created-at ::dt/instant]
[:modified-at ::dt/instant]] [:modified-at ::dt/instant]]
::sm/params ::sm/params
[:map {:title "RenameFileParams"} [:map {:title "RenameFileParams"}
[:name {:min 1} :string] [:name [:string {:min 1 :max 250}]]
[:id ::sm/uuid]] [:id ::sm/uuid]]
::sm/result ::sm/result
[:map {:title "SimplifiedFile"} [:map {:title "SimplifiedFile"}
[:id ::sm/uuid] [:id ::sm/uuid]
[:name :string] [:name [:string {:max 250}]]
[:created-at ::dt/instant] [:created-at ::dt/instant]
[:modified-at ::dt/instant]]} [:modified-at ::dt/instant]]}
@ -927,11 +911,11 @@
{:id file-id} {:id file-id}
{::db/return-keys [:id :name :is-shared :deleted-at {::db/return-keys [:id :name :is-shared :deleted-at
:project-id :created-at :modified-at]})] :project-id :created-at :modified-at]})]
(wrk/submit! {::wrk/task :delete-object (wrk/submit! {::db/conn conn
::wrk/conn conn ::wrk/task :delete-object
:object :file ::wrk/params {:object :file
:deleted-at (:deleted-at file) :deleted-at (:deleted-at file)
:id file-id}) :id file-id}})
file)) file))
(def ^:private (def ^:private
@ -1047,14 +1031,16 @@
{:id file-id} {:id file-id}
{::db/return-keys true})) {::db/return-keys true}))
(s/def ::ignore-file-library-sync-status (def ^:private schema:ignore-file-library-sync-status
(s/keys :req [::rpc/profile-id] [:map {:title "ignore-file-library-sync-status"}
:req-un [::file-id ::date])) [:file-id ::sm/uuid]
[:date ::dt/duration]])
;; TODO: improve naming ;; TODO: improve naming
(sv/defmethod ::ignore-file-library-sync-status (sv/defmethod ::ignore-file-library-sync-status
"Ignore updates in linked files" "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}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) (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 (def ^:private schema:create-file
[:map {:title "create-file"} [:map {:title "create-file"}
[:name :string] [:name [:string {:max 250}]]
[:project-id ::sm/uuid] [:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid] [:id {:optional true} ::sm/uuid]
[:is-shared {:optional true} :boolean] [: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 (ns app.rpc.commands.files-share
"Share link related rpc mutation methods." "Share link related rpc mutation methods."
(:require (:require
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.util.services :as sv] [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?))
;; --- MUTATION: Create Share Link ;; --- MUTATION: Create Share Link
(declare create-share-link) (declare create-share-link)
(s/def ::create-share-link (def ^:private schema:create-share-link
(s/keys :req [::rpc/profile-id] [:map {:title "create-share-link"}
:req-un [::file-id ::who-comment ::who-inspect ::pages])) [:file-id ::sm/uuid]
[:who-comment [:string {:max 250}]]
[:who-inspect [:string {:max 250}]]
[:pages [:set ::sm/uuid]]])
(sv/defmethod ::create-share-link (sv/defmethod ::create-share-link
"Creates a share-link object. "Creates a share-link object.
@ -37,7 +32,8 @@
Share links are resources that allows external users access to specific Share links are resources that allows external users access to specific
pages of a file with specific permissions (who-comment and who-inspect)." pages of a file with specific permissions (who-comment and who-inspect)."
{::doc/added "1.18" {::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}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
@ -58,13 +54,14 @@
;; --- MUTATION: Delete Share Link ;; --- MUTATION: Delete Share Link
(s/def ::delete-share-link (def ^:private schema:delete-share-link
(s/keys :req [::rpc/profile-id] [:map {:title "delete-share-link"}
:req-un [::us/id])) [:id ::sm/uuid]])
(sv/defmethod ::delete-share-link (sv/defmethod ::delete-share-link
{::doc/added "1.18" {::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}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [slink (db/get-by-id conn :share-link id)] (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 (def ^:private schema:create-temp-file
[:map {:title "create-temp-file"} [:map {:title "create-temp-file"}
[:name :string] [:name [:string {:max 250}]]
[:project-id ::sm/uuid] [:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid] [:id {:optional true} ::sm/uuid]
[:is-shared :boolean] [: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.pointer-map :as pmap]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s]
[cuerdas.core :as str])) [cuerdas.core :as str]))
;; --- FEATURES ;; --- FEATURES
@ -86,11 +85,8 @@
::doc/module :files ::doc/module :files
::sm/params [:map {:title "get-file-object-thumbnails"} ::sm/params [:map {:title "get-file-object-thumbnails"}
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:tag {:optional true} :string]] [:tag {:optional true} [:string {:max 50}]]]
::sm/result [:map-of :string :string] ::sm/result [:map-of [:string {:max 250}] [:string {:max 250}]]}
::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
::cond/reuse-key? true
::cond/key-fn files/get-file-etag}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id tag] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id tag] :as params}]
(dm/with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
@ -279,9 +275,9 @@
schema:create-file-object-thumbnail schema:create-file-object-thumbnail
[:map {:title "create-file-object-thumbnail"} [:map {:title "create-file-object-thumbnail"}
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:object-id :string] [:object-id [:string {:max 250}]]
[:media ::media/upload] [:media ::media/upload]
[:tag {:optional true} :string]]) [:tag {:optional true} [:string {:max 50}]]])
(sv/defmethod ::create-file-object-thumbnail (sv/defmethod ::create-file-object-thumbnail
{::doc/added "1.19" {::doc/added "1.19"
@ -317,25 +313,23 @@
:object-id object-id :object-id object-id
:tag tag}))) :tag tag})))
(s/def ::delete-file-object-thumbnail (def ^:private schema:delete-file-object-thumbnail
(s/keys :req [::rpc/profile-id] [:map {:title "delete-file-object-thumbnail"}
:req-un [::file-id ::object-id])) [:file-id ::sm/uuid]
[:object-id [:string {:max 250}]]])
(sv/defmethod ::delete-file-object-thumbnail (sv/defmethod ::delete-file-object-thumbnail
{::doc/added "1.19" {::doc/added "1.19"
::doc/module :files ::doc/module :files
::doc/deprecated "1.20" ::sm/params schema:delete-file-object-thumbnail
::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
[:file-thumbnail-ops/global]]
::audit/skip true} ::audit/skip true}
[cfg {:keys [::rpc/profile-id file-id object-id]}] [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}] (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id) (-> cfg
(when-not (db/read-only? conn) (update ::sto/storage media/configure-assets-storage conn)
(-> cfg (delete-file-object-thumbnail! file-id object-id))
(update ::sto/storage media/configure-assets-storage conn) nil)))
(delete-file-object-thumbnail! file-id object-id))
nil))))
;; --- MUTATION COMMAND: create-file-thumbnail ;; --- MUTATION COMMAND: create-file-thumbnail
@ -413,4 +407,5 @@
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(let [cfg (update cfg ::sto/storage media/configure-assets-storage) (let [cfg (update cfg ::sto/storage media/configure-assets-storage)
media (create-file-thumbnail! cfg params)] 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 [:vector [:map
[:changes [:vector ::cpc/change]] [:changes [:vector ::cpc/change]]
[:hint-origin {:optional true} :keyword] [:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]]]] [:hint-events {:optional true} [:vector [:string {:max 250}]]]]]]
[:skip-validate {:optional true} :boolean]]) [:skip-validate {:optional true} :boolean]])
(def ^:private (def ^:private
@ -123,12 +123,13 @@
(feat.fdata/persist-pointers! cfg id) (feat.fdata/persist-pointers! cfg id)
result)))) result))))
(declare get-lagged-changes) (declare ^:private delete-old-snapshots!)
(declare send-notifications!) (declare ^:private get-lagged-changes)
(declare update-file) (declare ^:private send-notifications!)
(declare update-file*) (declare ^:private take-snapshot?)
(declare update-file-data) (declare ^:private update-file)
(declare take-snapshot?) (declare ^:private update-file*)
(declare ^:private update-file-data)
;; If features are specified from params and the final feature ;; If features are specified from params and the final feature
;; set is different than the persisted one, update it on the ;; set is different than the persisted one, update it on the
@ -238,12 +239,15 @@
:created-at created-at :created-at created-at
:file-id (:id file) :file-id (:id file)
:revn (:revn file) :revn (:revn file)
:label (::snapshot-label file)
:data (::snapshot-data file)
:features (db/create-array conn "text" (:features file)) :features (db/create-array conn "text" (:features file))
:data (when (take-snapshot? file)
(:data file))
:changes (blob/encode changes)} :changes (blob/encode changes)}
{::db/return-keys false}) {::db/return-keys false})
(when (::snapshot-data file)
(delete-old-snapshots! cfg file))
(db/update! conn :file (db/update! conn :file
{:revn (:revn file) {:revn (:revn file)
:data (:data file) :data (:data file)
@ -262,8 +266,8 @@
;; Send asynchronous notifications ;; Send asynchronous notifications
(send-notifications! cfg params) (send-notifications! cfg params)
;; Retrieve and return lagged data {:revn (:revn file)
(get-lagged-changes conn params)))) :lagged (get-lagged-changes conn params)})))
(defn- soft-validate-file-schema! (defn- soft-validate-file-schema!
[file] [file]
@ -286,7 +290,6 @@
(-> data (-> data
(blob/decode) (blob/decode)
(assoc :id (:id file))))) (assoc :id (:id file)))))
;; For avoid unnecesary overhead of creating multiple pointers ;; For avoid unnecesary overhead of creating multiple pointers
;; and handly internally with objects map in their worst ;; and handly internally with objects map in their worst
;; case (when probably all shapes and all pointers will be ;; case (when probably all shapes and all pointers will be
@ -322,21 +325,42 @@
file (-> (files/check-version! file) file (-> (files/check-version! file)
(update :revn inc) (update :revn inc)
(update :data cpc/process-changes changes) (update :data cpc/process-changes changes)
(update :data d/without-nils))] (update :data d/without-nils))
(when (contains? cf/flags :soft-file-validation) file (if (take-snapshot? file)
(soft-validate-file! file libs)) (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) (l/trc :hint "take snapshot"
(soft-validate-file-schema! file)) :file-id (str (:id file))
:revn (:revn file)
:label label
:elapsed (dt/format-duration elapsed))
(when (and (contains? cf/flags :file-validation) (-> file
(not skip-validate)) (assoc ::snapshot-data snapshot)
(val/validate-file! file libs)) (assoc ::snapshot-label label)))
file)]
(when (and (contains? cf/flags :file-schema-validation) (binding [pmap/*tracked* nil]
(not skip-validate)) (when (contains? cf/flags :soft-file-validation)
(val/validate-file-schema! file)) (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 (cond-> file
(contains? cfeat/*current* "fdata/objects-map") (contains? cfeat/*current* "fdata/objects-map")
@ -351,13 +375,42 @@
(defn- take-snapshot? (defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved." "Defines the rule when file `data` snapshot should be saved."
[{:keys [revn modified-at] :as file}] [{:keys [revn modified-at] :as file}]
(let [freq (or (cf/get :file-change-snapshot-every) 20) (when (contains? cf/flags :file-snapshot)
timeout (or (cf/get :file-change-snapshot-timeout) (let [freq (or (cf/get :file-snapshot-every) 20)
(dt/duration {:hours 1}))] timeout (or (cf/get :file-snapshot-timeout)
(or (= 1 freq) (dt/duration {:hours 1}))]
(zero? (mod revn freq))
(> (inst-ms (dt/diff modified-at (dt/now))) (or (= 1 freq)
(inst-ms timeout))))) (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 (def ^:private
sql:lagged-changes sql:lagged-changes

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

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

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

@ -16,6 +16,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http.sse :as sse] [app.http.sse :as sse]
[app.loggers.audit :as audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
@ -90,7 +91,7 @@
(sm/define (sm/define
[:map {:title "duplicate-file"} [:map {:title "duplicate-file"}
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:name {:optional true} :string]])) [:name {:optional true} [:string {:max 250}]]]))
(sv/defmethod ::duplicate-file (sv/defmethod ::duplicate-file
"Duplicate a single file in the same team." "Duplicate a single file in the same team."
@ -152,7 +153,7 @@
(sm/define (sm/define
[:map {:title "duplicate-project"} [:map {:title "duplicate-project"}
[:project-id ::sm/uuid] [:project-id ::sm/uuid]
[:name {:optional true} :string]])) [:name {:optional true} [:string {:max 250}]]]))
(sv/defmethod ::duplicate-project (sv/defmethod ::duplicate-project
"Duplicate an entire project with all the files" "Duplicate an entire project with all the files"
@ -397,17 +398,30 @@
;; --- COMMAND: Clone Template ;; --- COMMAND: Clone Template
(defn- clone-template (defn- clone-template
[{:keys [::wrk/executor ::bf.v1/project-id] :as cfg} template] [cfg {:keys [project-id ::rpc/profile-id] :as params} template]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}] (db/tx-run! cfg (fn [{:keys [::db/conn ::wrk/executor] :as cfg}]
;; NOTE: the importation process performs some operations that ;; NOTE: the importation process performs some operations that
;; are not very friendly with virtual threads, and for avoid ;; are not very friendly with virtual threads, and for avoid
;; unexpected blocking of other concurrent operations we ;; unexpected blocking of other concurrent operations we
;; dispatch that operation to a dedicated executor. ;; 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 (db/update! conn :project
{:modified-at (dt/now)} {:modified-at (dt/now)}
{:id project-id}) {: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 (def ^:private
schema:clone-template schema:clone-template
@ -425,16 +439,14 @@
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id template-id] :as params}] [{: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]}) (let [project (db/get-by-id pool :project project-id {:columns [:id :team-id]})
_ (teams/check-edition-permissions! pool profile-id (:team-id project)) _ (teams/check-edition-permissions! pool profile-id (:team-id project))
template (tmpl/get-template-stream cfg template-id) template (tmpl/get-template-stream cfg template-id)]
params (-> cfg
(assoc ::bf.v1/project-id (:id project))
(assoc ::bf.v1/profile-id profile-id))]
(when-not template (when-not template
(ex/raise :type :not-found (ex/raise :type :not-found
:code :template-not-found :code :template-not-found
:hint "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 ;; --- 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.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm] [app.common.media :as cm]
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
@ -25,7 +25,6 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.io :as io] [datoteka.io :as io]
[promesa.exec :as px])) [promesa.exec :as px]))
@ -39,25 +38,21 @@
:quality 85 :quality 85
:format :jpeg}) :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) ;; --- Create File Media object (upload)
(declare create-file-media-object) (declare create-file-media-object)
(s/def ::content ::media/upload) (def ^:private schema:upload-file-media-object
(s/def ::is-local ::us/boolean) [:map {:title "upload-file-media-object"}
[:id {:optional true} ::sm/uuid]
(s/def ::upload-file-media-object [:file-id ::sm/uuid]
(s/keys :req [::rpc/profile-id] [:is-local :boolean]
:req-un [::file-id ::is-local ::name ::content] [:name [:string {:max 250}]]
:opt-un [::id])) [:content ::media/upload]])
(sv/defmethod ::upload-file-media-object (sv/defmethod ::upload-file-media-object
{::doc/added "1.17" {::doc/added "1.17"
::sm/params schema:upload-file-media-object
::climit/id [[:process-image/by-profile ::rpc/profile-id] ::climit/id [[:process-image/by-profile ::rpc/profile-id]
[:process-image/global]]} [:process-image/global]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}] [{: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) (declare ^:private create-file-media-object-from-url)
(s/def ::create-file-media-object-from-url (def ^:private schema:create-file-media-object-from-url
(s/keys :req [::rpc/profile-id] [:map {:title "create-file-media-object-from-url"}
:req-un [::file-id ::is-local ::url] [:file-id ::sm/uuid]
:opt-un [::id ::name])) [: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 (sv/defmethod ::create-file-media-object-from-url
{::doc/added "1.17" {::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}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
@ -255,12 +253,15 @@
(declare clone-file-media-object) (declare clone-file-media-object)
(s/def ::clone-file-media-object (def ^:private schema:clone-file-media-object
(s/keys :req [::rpc/profile-id] [:map {:title "clone-file-media-object"}
:req-un [::file-id ::is-local ::id])) [:file-id ::sm/uuid]
[:is-local :boolean]
[:id ::sm/uuid]])
(sv/defmethod ::clone-file-media-object (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}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (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.tokens :as tokens]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as wrk]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.exec :as px])) [promesa.exec :as px]))
@ -276,19 +276,19 @@
(sv/defmethod ::request-email-change (sv/defmethod ::request-email-change
{::doc/added "1.0" {::doc/added "1.0"
::sm/params schema:request-email-change} ::sm/params schema:request-email-change}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}] [cfg {:keys [::rpc/profile-id email] :as params}]
(db/with-atomic [conn pool] (db/tx-run! cfg
(let [profile (db/get-by-id conn :profile profile-id) (fn [cfg]
cfg (assoc cfg ::conn conn) (let [profile (db/get-by-id cfg :profile profile-id)
params (assoc params params (assoc params
:profile profile :profile profile
:email (clean-email email))] :email (clean-email email))]
(if (contains? cf/flags :smtp) (if (contains? cf/flags :smtp)
(request-email-change! cfg params) (request-email-change! cfg params)
(change-email-immediately! cfg params))))) (change-email-immediately! cfg params))))))
(defn- change-email-immediately! (defn- change-email-immediately!
[{:keys [::conn]} {:keys [profile email] :as params}] [{:keys [::db/conn]} {:keys [profile email] :as params}]
(when (not= email (:email profile)) (when (not= email (:email profile))
(check-profile-existence! conn params)) (check-profile-existence! conn params))
@ -299,7 +299,7 @@
{:changed true}) {:changed true})
(defn- request-email-change! (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) (let [token (tokens/generate (::setup/props cfg)
{:iss :change-email {:iss :change-email
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
@ -319,9 +319,28 @@
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces.")) :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when (eml/has-bounce-reports? conn email) (when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation (ex/raise :type :restriction
:code :email-has-permanent-bounces :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/send! {::eml/conn conn
::eml/factory eml/change-email ::eml/factory eml/change-email
@ -366,13 +385,13 @@
;; --- MUTATION: Delete Profile ;; --- MUTATION: Delete Profile
(declare ^:private get-owned-teams-with-participants) (declare ^:private get-owned-teams)
(sv/defmethod ::delete-profile (sv/defmethod ::delete-profile
{::doc/added "1.0"} {::doc/added "1.0"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (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)] deleted-at (dt/now)]
;; If we found owned teams with participants, we don't allow ;; 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." :hint "The user need to transfer ownership of owned teams."
:context {:teams (mapv :id teams)})) :context {:teams (mapv :id teams)}))
(doseq [{:keys [id]} teams] ;; Mark profile deleted immediatelly
(db/update! conn :team
{:deleted-at deleted-at}
{:id id}))
(db/update! conn :profile (db/update! conn :profile
{:deleted-at deleted-at} {:deleted-at deleted-at}
{:id profile-id}) {: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))))) (rph/with-transform {} (session/delete-fn cfg)))))
;; --- HELPERS ;; --- HELPERS
(def sql:owned-teams (def sql:owned-teams
"with owner_teams as ( "WITH owner_teams AS (
select tpr.team_id as id SELECT tpr.team_id AS id
from team_profile_rel as tpr FROM team_profile_rel AS tpr
where tpr.is_owner is true WHERE tpr.is_owner IS TRUE
and tpr.profile_id = ? AND tpr.profile_id = ?
) )
select tpr.team_id as id, SELECT tpr.team_id AS id,
count(tpr.profile_id) - 1 as participants count(tpr.profile_id) - 1 AS participants
from team_profile_rel as tpr FROM team_profile_rel AS tpr
where tpr.team_id in (select id from owner_teams) WHERE tpr.team_id IN (SELECT id from owner_teams)
and tpr.profile_id != ? GROUP BY 1")
group by 1")
(defn- get-owned-teams-with-participants (defn get-owned-teams
[conn profile-id] [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 (def ^:private sql:profile-existence
"select exists (select * from profile "select exists (select * from profile

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

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

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

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

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

@ -98,7 +98,7 @@
(assoc ::perms perms) (assoc ::perms perms)
(assoc :profile-id profile-id))] (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. ;; found response to the user.
(when-not perms (when-not perms
(ex/raise :type :not-found (ex/raise :type :not-found

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

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

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

@ -83,17 +83,17 @@
"- Quote ID: '~(::target params)'\n" "- Quote ID: '~(::target params)'\n"
"- Max: ~(::quote params)\n" "- Max: ~(::quote params)\n"
"- Total: ~(::total params) (INCR ~(::incr params 1))\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/delay (dt/duration "30s")
::wrk/max-retries 4 ::wrk/max-retries 4
::wrk/priority 200 ::wrk/priority 200
::wrk/conn conn
::wrk/dedupe true ::wrk/dedupe true
::wrk/label "quotes-notification" ::wrk/label "quotes-notification"
:to (vec admins) ::wrk/params {:to (vec admins)
:subject subject :subject subject
:body [{:type "text/plain" :body [{:type "text/plain"
:content content}]})))) :content content}]}}))))
(defn- generic-check! (defn- generic-check!
[{:keys [::db/conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}] [{: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.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.http :as-alias http] [app.http :as-alias http]
[app.loggers.audit :refer [parse-client-ip]]
[app.redis :as rds] [app.redis :as rds]
[app.redis.script :as-alias rscript] [app.redis.script :as-alias rscript]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.helpers :as rph] [app.rpc.helpers :as rph]
[app.rpc.rlimit.result :as-alias lresult] [app.rpc.rlimit.result :as-alias lresult]
[app.util.inet :as inet]
[app.util.services :as-alias sv] [app.util.services :as-alias sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
@ -215,7 +215,7 @@
[{:keys [::rpc/profile-id] :as params}] [{:keys [::rpc/profile-id] :as params}]
(let [request (-> params meta ::http/request)] (let [request (-> params meta ::http/request)]
(or profile-id (or profile-id
(some-> request parse-client-ip) (some-> request inet/parse-request)
uuid/zero))) uuid/zero)))
(defn process-request! (defn process-request!

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

@ -184,10 +184,7 @@
(ctk/instance-head? child)) (ctk/instance-head? child))
(let [slot (guess-swap-slot component-child component-container)] (let [slot (guess-swap-slot component-child component-container)]
(l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot) (l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot)
(ctn/update-shape container (:id child) (ctn/update-shape container (:id child) #(ctk/set-swap-slot % slot)))
#(update % :touched
cfh/set-touched-group
(ctk/build-swap-slot-group slot))))
container)] container)]
(recur (process-copy-head container child) (recur (process-copy-head container child)
(rest children) (rest children)
@ -237,3 +234,44 @@
file (-> file file (-> file
(update :data process-fdata)))) (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.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.db.sql :as-alias sql]
[app.features.components-v2 :as feat.comp-v2] [app.features.components-v2 :as feat.comp-v2]
[app.features.fdata :as feat.fdata] [app.features.fdata :as feat.fdata]
[app.loggers.audit :as audit]
[app.main :as main] [app.main :as main]
[app.msgbus :as mbus] [app.msgbus :as mbus]
[app.rpc.commands.auth :as auth] [app.rpc.commands.auth :as auth]
@ -38,10 +40,12 @@
[app.util.pointer-map :as pmap] [app.util.pointer-map :as pmap]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.java.io :as io]
[clojure.pprint :refer [print-table]] [clojure.pprint :refer [print-table]]
[clojure.stacktrace :as strace] [clojure.stacktrace :as strace]
[clojure.tools.namespace.repl :as repl] [clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.fs :as fs]
[promesa.exec :as px] [promesa.exec :as px]
[promesa.exec.semaphore :as ps] [promesa.exec.semaphore :as ps]
[promesa.util :as pu])) [promesa.util :as pu]))
@ -59,32 +63,27 @@
([tname] ([tname]
(run-task! tname {})) (run-task! tname {}))
([tname params] ([tname params]
(let [tasks (:app.worker/registry main/system) (wrk/invoke! (-> main/system
tname (if (keyword? tname) (name tname) name)] (assoc ::wrk/task tname)
(if-let [task-fn (get tasks tname)] (assoc ::wrk/params params)))))
(task-fn params)
(println (format "no task '%s' found" tname))))))
(defn schedule-task! (defn schedule-task!
([name] ([name]
(schedule-task! name {})) (schedule-task! name {}))
([name props] ([name params]
(let [pool (:app.db/pool main/system)] (wrk/submit! (-> main/system
(wrk/submit! (assoc ::wrk/task name)
::wrk/conn pool (assoc ::wrk/params params)))))
::wrk/task name
::wrk/props props))))
(defn send-test-email! (defn send-test-email!
[destination] [destination]
(us/verify! (assert (string? destination) "destination should be provided")
:expr (string? destination) (-> main/system
:hint "destination should be provided") (assoc ::wrk/task :sendmail)
(assoc ::wrk/params {:body "test email"
(let [handler (:app.email/sendmail main/system)] :subject "test email"
(handler {:body "test email" :to [destination]})
:subject "test email" (wrk/invoke!)))
:to [destination]})))
(defn resend-email-verification-email! (defn resend-email-verification-email!
[email] [email]
@ -195,6 +194,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn notify! (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] [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
:or {code :generic level :info} :or {code :generic level :info}
:as params}] :as params}]
@ -202,10 +207,6 @@
["invalid level %" level] ["invalid level %" level]
(contains? #{:success :error :info :warning} level)) (contains? #{:success :error :info :warning} level))
(dm/verify!
["invalid code: %" code]
(contains? #{:generic :upgrade-version} code))
(letfn [(send [dest] (letfn [(send [dest]
(l/inf :hint "sending notification" :dest (str dest)) (l/inf :hint "sending notification" :dest (str dest))
(let [message {:type :notification (let [message {:type :notification
@ -231,6 +232,9 @@
(resolve-dest [dest] (resolve-dest [dest]
(cond (cond
(= :all dest)
[uuid/zero]
(uuid? dest) (uuid? dest)
[dest] [dest]
@ -246,14 +250,15 @@
(mapcat resolve-dest)) (mapcat resolve-dest))
dest) dest)
(and (coll? dest) (and (vector? dest)
(every? coll? dest)) (every? vector? dest))
(sequence (comp (sequence (comp
(map vec) (map vec)
(mapcat resolve-dest)) (mapcat resolve-dest))
dest) dest)
(vector? dest) (and (vector? dest)
(keyword? (first dest)))
(let [[op param] dest] (let [[op param] dest]
(cond (cond
(= op :email) (= op :email)
@ -480,6 +485,27 @@
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT) ;; 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* (defn- restore-file*
[{:keys [::db/conn]} file-id] [{:keys [::db/conn]} file-id]
(db/update! conn :file (db/update! conn :file
@ -507,22 +533,105 @@
:restored) :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* (defn- restore-project*
[{:keys [::db/conn] :as cfg} project-id] [{:keys [::db/conn] :as cfg} project-id]
(db/update! conn :project (db/update! conn :project
{:deleted-at nil} {:deleted-at nil}
{:id project-id}) {:id project-id})
(doseq [{:keys [id]} (db/query conn :file (doseq [{:keys [id]} (db/query conn :file
{:project-id project-id} {:project-id project-id}
{::db/columns [:id]})] {::sql/columns [:id]})]
(restore-file* cfg id)) (restore-file* cfg id))
:restored) :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* (defn- restore-team*
[{:keys [::db/conn] :as cfg} team-id] [{:keys [::db/conn] :as cfg} team-id]
(db/update! conn :team (db/update! conn :team
@ -535,49 +644,167 @@
(doseq [{:keys [id]} (db/query conn :project (doseq [{:keys [id]} (db/query conn :project
{:team-id team-id} {:team-id team-id}
{::db/columns [:id]})] {::sql/columns [:id]})]
(restore-project* cfg id)) (restore-project* cfg id))
:restored) :restored)
(defn restore-deleted-team! (defn restore-team!
"Mark a team and all related objects as not deleted" "Mark a team and all related objects as not deleted"
[team-id] [team-id]
(let [team-id (h/parse-uuid 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! (restore-team* system team-id))))))
"Mark a project and all related objects as not deleted"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system restore-project* project-id)))
(defn restore-deleted-file! (defn delete-profile!
"Mark a file and all related objects as not deleted" "Mark a profile for deletion."
[file-id] [profile-id]
(let [file-id (h/parse-uuid file-id)] (let [profile-id (h/parse-uuid profile-id)
(db/tx-run! main/system restore-file* file-id))) tnow (dt/now)]
(defn delete-team! (audit/insert! main/system
"Mark a team for deletion" {::audit/name "delete-profile"
[team-id] ::audit/type "action"
(let [team-id (h/parse-uuid team-id)] ::audit/profile-id uuid/zero
(db/tx-run! main/system (fn [{:keys [::db/conn]}] ::audit/context {:triggered-by "srepl"
(#'teams/delete-team conn team-id))))) :cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(defn delete-project! (wrk/invoke! (-> main/system
"Mark a project for deletion" (assoc ::wrk/task :delete-object)
[project-id] (assoc ::wrk/params {:object :profile
(let [project-id (h/parse-uuid project-id)] :deleted-at tnow
(db/tx-run! main/system (fn [{:keys [::db/conn]}] :id profile-id})))
(#'projects/delete-project conn project-id))))) :deleted))
(defn delete-file! (defn restore-profile!
"Mark a project for deletion" "Mark a team and all related objects as not deleted"
[file-id] [profile-id]
(let [file-id (h/parse-uuid file-id)] (let [profile-id (h/parse-uuid profile-id)]
(db/tx-run! main/system (fn [{:keys [::db/conn]}] (db/tx-run! main/system
(#'files/mark-file-deleted conn file-id))))) (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 ;; MISC

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

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

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

@ -10,6 +10,8 @@
[app.common.logging :as l] [app.common.logging :as l]
[app.db :as db] [app.db :as db]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
[app.rpc.commands.profile :as profile]
[app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig])) [integrant.core :as ig]))
@ -20,8 +22,15 @@
(defmethod delete-object :file (defmethod delete-object :file
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] [{: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})] (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) (when (and (:is-shared file)
(not *team-deletion*)) (not *team-deletion*))
;; NOTE: we don't prevent file deletion on absorb operation failure ;; NOTE: we don't prevent file deletion on absorb operation failure
@ -48,28 +57,57 @@
(defmethod delete-object :project (defmethod delete-object :project
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
(l/trc :hint "marking for deletion" :rel "project" :id (str id)) (l/trc :hint "marking for deletion" :rel "project" :id (str id)
(doseq [file (db/update! conn :file :deleted-at (dt/format-instant deleted-at))
{:deleted-at deleted-at}
{:project-id id} (db/update! conn :project
{::db/return-keys [:id :deleted-at] {:deleted-at deleted-at}
::db/many true})] {:id id}
(delete-object cfg (assoc file :object :file)))) {::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 (defmethod delete-object :team
[{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] [{: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 (db/update! conn :team-font-variant
{:deleted-at deleted-at} {:deleted-at deleted-at}
{:team-id id}) {:team-id id}
{::db/return-keys false})
(binding [*team-deletion* true] (binding [*team-deletion* true]
(doseq [project (db/update! conn :project (doseq [project (db/query conn :project
{:deleted-at deleted-at} {:team-id id}
{:team-id id} {::db/columns [:id :deleted-at]})]
{::db/return-keys [:id :deleted-at] (delete-object cfg (assoc project
::db/many true})] :object :project
(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 (defmethod delete-object :default
[_cfg props] [_cfg props]
@ -80,5 +118,5 @@
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ cfg] [_ cfg]
(fn [{:keys [props] :as params}] (fn [{:keys [props] :as task}]
(db/tx-run! cfg delete-object props))) (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 (defmethod ig/prep-key ::handler
[_ cfg] [_ cfg]
(assoc cfg ::min-age cf/deletion-delay)) (assoc cfg ::min-age (cf/get-deletion-delay)))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ cfg] [_ cfg]
(fn [{:keys [file-id] :as params}] (fn [{:keys [props] :as task}]
(db/tx-run! cfg (db/tx-run! cfg
(fn [{:keys [::db/conn] :as 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 cfg (-> cfg
(update ::sto/storage media/configure-assets-storage conn) (update ::sto/storage media/configure-assets-storage conn)
(assoc ::file-id file-id) (assoc ::file-id (:file-id props))
(assoc ::min-age min-age)) (assoc ::min-age min-age))
total (reduce (fn [total file] total (reduce (fn [total file]
@ -314,12 +314,12 @@
0 0
(get-candidates cfg))] (get-candidates cfg))]
(l/inf :hint "task finished" (l/inf :hint "finished"
:min-age (dt/format-duration min-age) :min-age (dt/format-duration min-age)
:processed total) :processed total)
;; Allow optional rollback passed by params ;; Allow optional rollback passed by params
(when (:rollback? params) (when (:rollback? props)
(db/rollback! conn)) (db/rollback! conn))
{:processed total}))))) {:processed total})))))

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

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

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

@ -35,11 +35,6 @@
;; Mark as deleted the storage object ;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage)) (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}) (db/delete! conn :profile {:id id})
(inc total)) (inc total))
@ -269,15 +264,15 @@
0))) 0)))
(def ^:private deletion-proc-vars (def ^:private deletion-proc-vars
[#'delete-file-media-objects! [#'delete-profiles!
#'delete-file-media-objects!
#'delete-file-data-fragments! #'delete-file-data-fragments!
#'delete-file-object-thumbnails! #'delete-file-object-thumbnails!
#'delete-file-thumbnails! #'delete-file-thumbnails!
#'delete-files! #'delete-files!
#'delete-projects! #'delete-projects!
#'delete-fonts! #'delete-fonts!
#'delete-teams! #'delete-teams!])
#'delete-profiles!])
(defn- execute-proc! (defn- execute-proc!
"A generic function that executes the specified proc iterativelly "A generic function that executes the specified proc iterativelly
@ -297,13 +292,13 @@
(defmethod ig/prep-key ::handler (defmethod ig/prep-key ::handler
[_ cfg] [_ cfg]
(assoc cfg (assoc cfg
::min-age cf/deletion-delay ::min-age (cf/get-deletion-delay)
::chunk-size 10)) ::chunk-size 10))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ cfg] [_ cfg]
(fn [params] (fn [{:keys [props] :as task}]
(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 cfg (-> cfg
(assoc ::min-age (db/interval min-age)) (assoc ::min-age (db/interval min-age))
(update ::sto/storage media/configure-assets-storage))] (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 (defmethod ig/prep-key ::handler
[_ cfg] [_ cfg]
(assoc cfg ::min-age cf/deletion-delay)) (assoc cfg ::min-age (cf/get-deletion-delay)))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [::db/pool ::min-age] :as cfg}] [_ {:keys [::db/pool ::min-age] :as cfg}]
(fn [params] (fn [{:keys [props] :as task}]
(let [min-age (or (:min-age params) min-age)] (let [min-age (or (:min-age props) min-age)]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [interval (db/interval min-age) (let [interval (db/interval min-age)
result (db/exec-one! conn [sql:delete-completed-tasks interval]) result (db/exec-one! conn [sql:delete-completed-tasks interval])
@ -36,7 +36,7 @@
(l/debug :hint "task finished" :total result) (l/debug :hint "task finished" :total result)
(when (:rollback? params) (when (:rollback? props)
(db/rollback! conn)) (db/rollback! conn))
result))))) result)))))

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

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

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

@ -8,18 +8,19 @@
"Tokens generation API." "Tokens generation API."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.transit :as t] [app.common.transit :as t]
[app.util.time :as dt] [app.util.time :as dt]
[buddy.sign.jwe :as jwe] [buddy.sign.jwe :as jwe]))
[clojure.spec.alpha :as s]))
(s/def ::tokens-key bytes?)
(defn generate (defn generate
[{:keys [tokens-key]} claims] [{: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 (let [payload (-> claims
(assoc :iat (dt/now)) (assoc :iat (dt/now))
(d/without-nils) (d/without-nils)
@ -39,15 +40,13 @@
(ex/raise :type :validation (ex/raise :type :validation
:code :invalid-token :code :invalid-token
:reason :token-expired :reason :token-expired
:params params :params params))
:claims claims))
(when (and (contains? params :iss) (when (and (contains? params :iss)
(not= (:iss claims) (not= (:iss claims)
(:iss params))) (:iss params)))
(ex/raise :type :validation (ex/raise :type :validation
:code :invalid-token :code :invalid-token
:reason :invalid-issuer :reason :invalid-issuer
:claims claims
:params params)) :params params))
claims)) 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.fressian :as fres]
[app.common.transit :as t] [app.common.transit :as t]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[clojure.core :as c]) [clojure.core :as c]
[clojure.data.json :as json])
(:import (:import
clojure.lang.Counted clojure.lang.Counted
clojure.lang.IHashEq clojure.lang.IHashEq
@ -83,6 +84,10 @@
^:unsynchronized-mutable loaded? ^:unsynchronized-mutable loaded?
^:unsynchronized-mutable modified?] ^:unsynchronized-mutable modified?]
json/JSONWriter
(-write [this writter options]
(json/-write (into {} this) writter options))
IHashEq IHashEq
(hasheq [this] (hasheq [this]
(when-not hash (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.transit :as t]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.core :as c]) [clojure.core :as c]
[clojure.data.json :as json])
(:import (:import
clojure.lang.Counted clojure.lang.Counted
clojure.lang.IDeref clojure.lang.IDeref
@ -75,6 +76,14 @@
^:unsynchronized-mutable modified? ^:unsynchronized-mutable modified?
^:unsynchronized-mutable loaded?] ^:unsynchronized-mutable loaded?]
json/JSONWriter
(-write [this writter options]
(json/-write {:type "pointer"
:id (get-id this)
:meta (meta this)}
writter
options))
IPointerMap IPointerMap
(load! [_] (load! [_]
(when-not *load-fn* (when-not *load-fn*

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

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

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

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

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

@ -8,6 +8,7 @@
"Async tasks abstraction (impl)." "Async tasks abstraction (impl)."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
@ -58,17 +59,6 @@
;; SUBMIT API ;; 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 (def ^:private sql:insert-new-task
"insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at) "insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at)
values (?, ?, ?, ?, ?, ?, ?, now() + ?) values (?, ?, ?, ?, ?, ?, ?, now() + ?)
@ -87,14 +77,13 @@
(s/def ::task (s/or :kw keyword? :str string?)) (s/def ::task (s/or :kw keyword? :str string?))
(s/def ::queue (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 ::delay (s/or :int integer? :duration dt/duration?))
(s/def ::conn (s/or :pool ::db/pool :connection some?))
(s/def ::priority integer?) (s/def ::priority integer?)
(s/def ::max-retries integer?) (s/def ::max-retries integer?)
(s/def ::dedupe boolean?) (s/def ::dedupe boolean?)
(s/def ::submit-options (s/def ::submit-options
(s/and (s/and
(s/keys :req [::task ::conn] (s/keys :req [::task]
:opt [::label ::delay ::queue ::priority ::max-retries ::dedupe]) :opt [::label ::delay ::queue ::priority ::max-retries ::dedupe])
(fn [{:keys [::dedupe ::label] :or {label ""}}] (fn [{:keys [::dedupe ::label] :or {label ""}}]
(if dedupe (if dedupe
@ -102,21 +91,23 @@
true)))) true))))
(defn submit! (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 ""} :or {delay 0 queue :default priority 100 max-retries 3 label ""}
:as options}] :as options}]
(us/verify! ::submit-options options) (us/verify! ::submit-options options)
(let [duration (dt/duration delay) (let [duration (dt/duration delay)
interval (db/interval duration) interval (db/interval duration)
props (-> options extract-props db/tjson) props (db/tjson params)
id (uuid/next) id (uuid/next)
tenant (cf/get :tenant) tenant (cf/get :tenant)
task (d/name task) task (d/name task)
queue (str/ffmt "%:%" tenant (d/name queue)) queue (str/ffmt "%:%" tenant (d/name queue))
conn (db/get-connectable options)
deleted (when dedupe deleted (when dedupe
(-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label]) (-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
:next.jdbc/update-count))] :next.jdbc/update-count))]
(l/trc :hint "submit task" (l/trc :hint "submit task"
:name task :name task
:task-id (str id) :task-id (str id)
@ -126,7 +117,13 @@
:delay (dt/format-duration duration) :delay (dt/format-duration duration)
:replace (or deleted 0)) :replace (or deleted 0))
(db/exec-one! conn [sql:insert-new-task id task props queue (db/exec-one! conn [sql:insert-new-task id task props queue
label priority max-retries interval]) label priority max-retries interval])
id)) 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.blob :as blob]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk]
[app.worker.runner] [app.worker.runner]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -57,15 +58,14 @@
(def ^:dynamic *system* nil) (def ^:dynamic *system* nil)
(def ^:dynamic *pool* nil) (def ^:dynamic *pool* nil)
(def defaults (def default
{:database-uri "postgresql://postgres/penpot_test" {:database-uri "postgresql://postgres/penpot_test"
:redis-uri "redis://redis/1" :redis-uri "redis://redis/1"
:file-change-snapshot-every 1}) :file-snapshot-every 1})
(def config (def config
(->> (cf/read-env "penpot-test") (cf/read-config :prefix "penpot-test"
(merge cf/defaults defaults) :default (merge cf/default default)))
(us/conform ::cf/config)))
(def default-flags (def default-flags
[:enable-secure-session-cookies [:enable-secure-session-cookies
@ -76,6 +76,7 @@
:enable-feature-fdata-pointer-map :enable-feature-fdata-pointer-map
:enable-feature-fdata-objets-map :enable-feature-fdata-objets-map
:enable-feature-components-v2 :enable-feature-components-v2
:enable-file-snapshot
:disable-file-validation]) :disable-file-validation])
(defn state-init (defn state-init
@ -87,6 +88,8 @@
app.auth/verify-password (fn [a b] {:valid (= a b)}) app.auth/verify-password (fn [a b] {:valid (= a b)})
app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)] app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)]
(cf/validate! :exit-on-error? false)
(fs/create-dir "/tmp/penpot") (fs/create-dir "/tmp/penpot")
(let [templates [{:id "test" (let [templates [{:id "test"
@ -103,10 +106,10 @@
(dissoc :app.srepl/server (dissoc :app.srepl/server
:app.http/server :app.http/server
:app.http/router :app.http/router
:app.auth.oidc/google-provider :app.auth.oidc.providers/google
:app.auth.oidc/gitlab-provider :app.auth.oidc.providers/gitlab
:app.auth.oidc/github-provider :app.auth.oidc.providers/github
:app.auth.oidc/generic-provider :app.auth.oidc.providers/generic
:app.setup/templates :app.setup/templates
:app.auth.oidc/routes :app.auth.oidc/routes
:app.worker/monitor :app.worker/monitor
@ -377,9 +380,9 @@
([name] ([name]
(run-task! name {})) (run-task! name {}))
([name params] ([name params]
(let [tasks (:app.worker/registry *system*)] (wrk/invoke! (-> *system*
(let [task-fn (get tasks (d/name name))] (assoc ::wrk/task name)
(task-fn params))))) (assoc ::wrk/params params)))))
(def sql:pending-tasks (def sql:pending-tasks
"select t.* from task as t "select t.* from task as t
@ -523,7 +526,6 @@
([key default] ([key default]
(get data key (get cf/config key default))))) (get data key (get cf/config key default)))))
(defn reset-mock! (defn reset-mock!
[m] [m]
(swap! m (fn [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}] (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}]
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
res (th/run-task! :process-webhook-event res (th/run-task! :process-webhook-event
{:props {:event
{:app.loggers.webhooks/event {:type "command"
{:type "command" :name "create-project"
:name "create-project" :props {:team-id (:default-team-id prof)}}})]
:props {:team-id (:default-team-id prof)}}}})]
(t/is (= 0 (:call-count @submit-mock))) (t/is (= 0 (:call-count @submit-mock)))
(t/is (nil? res))))) (t/is (nil? res)))))
@ -35,11 +34,10 @@
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
whk (th/create-webhook* {:team-id (:default-team-id prof)}) whk (th/create-webhook* {:team-id (:default-team-id prof)})
res (th/run-task! :process-webhook-event res (th/run-task! :process-webhook-event
{:props {:event
{:app.loggers.webhooks/event {:type "command"
{:type "command" :name "create-project"
:name "create-project" :props {:team-id (:default-team-id prof)}}})]
:props {:team-id (:default-team-id prof)}}}})]
(t/is (= 1 (:call-count @submit-mock))) (t/is (= 1 (:call-count @submit-mock)))
(t/is (nil? res))))) (t/is (nil? res)))))
@ -52,9 +50,8 @@
:name "create-project" :name "create-project"
:props {:team-id (:default-team-id prof)}} :props {:team-id (:default-team-id prof)}}
res (th/run-task! :run-webhook res (th/run-task! :run-webhook
{:props {:event evt
{:app.loggers.webhooks/event evt :config whk})]
:app.loggers.webhooks/config whk}})]
(t/is (= 1 (:call-count @http-mock))) (t/is (= 1 (:call-count @http-mock)))
@ -75,9 +72,8 @@
:name "create-project" :name "create-project"
:props {:team-id (:default-team-id prof)}} :props {:team-id (:default-team-id prof)}}
res (th/run-task! :run-webhook res (th/run-task! :run-webhook
{:props {:event evt
{:app.loggers.webhooks/event evt :config whk})]
:app.loggers.webhooks/config whk}})]
(t/is (= 1 (:call-count @http-mock))) (t/is (= 1 (:call-count @http-mock)))
@ -94,14 +90,12 @@
;; RUN 2 times more ;; RUN 2 times more
(th/run-task! :run-webhook (th/run-task! :run-webhook
{:props {:event evt
{:app.loggers.webhooks/event evt :config whk})
:app.loggers.webhooks/config whk}})
(th/run-task! :run-webhook (th/run-task! :run-webhook
{:props {:event evt
{:app.loggers.webhooks/event evt :config whk})
:app.loggers.webhooks/config whk}})
(let [rows (th/db-query :webhook-delivery {:webhook-id (:id 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 ring.request/Request
(get-header [_ name] (get-header [_ name]
(case 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 (t/deftest push-events-1
(with-redefs [app.config/flags #{:audit-log}] (with-redefs [app.config/flags #{:audit-log}]
@ -46,6 +47,7 @@
:profile-id (:id prof) :profile-id (:id prof)
:timestamp (dt/now) :timestamp (dt/now)
:type "action"}]} :type "action"}]}
params (with-meta params params (with-meta params
{:app.http/request http-request}) {:app.http/request http-request})

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

@ -166,6 +166,10 @@
:name "test" :name "test"
:id page-id}]) :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 ;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
@ -176,11 +180,11 @@
;; The objects-gc should remove unused fragments ;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})] (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 ;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (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 ;; Add shape to page that should add a new fragment
(update-file! (update-file!
@ -203,7 +207,7 @@
;; Check the number of fragments ;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (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 ;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
@ -211,13 +215,13 @@
;; The objects-gc should remove unused fragments ;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})] (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 ;; Check the number of fragments; should be 3 because changes
;; are also holding pointers to fragments; ;; are also holding pointers to fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file) (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})] :deleted-at nil})]
(t/is (= 6 (count rows)))) (t/is (= 2 (count rows))))
;; Lets proceed to delete all changes ;; Lets proceed to delete all changes
(th/db-delete! :file-change {:file-id (:id file)}) (th/db-delete! :file-change {:file-id (:id file)})
@ -233,11 +237,11 @@
;; Check the number of fragments; ;; Check the number of fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
;; (pp/pprint rows) ;; (pp/pprint rows)
(t/is (= 8 (count rows))) (t/is (= 4 (count rows)))
(t/is (= 2 (count (remove (comp some? :deleted-at) rows))))) (t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (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)})] (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))))) (t/is (= 2 (count rows)))))))
@ -338,7 +342,7 @@
(t/is (= 1 (count (remove (comp some? :deleted-at) rows))))) (t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res)))) (t/is (= 3 (:processed res))))
;; check file media objects ;; check file media objects
(let [rows (th/db-query :file-media-object {:file-id (:id file)})] (let [rows (th/db-query :file-media-object {:file-id (:id file)})]
@ -367,7 +371,7 @@
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (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, ;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of ;; lets execute the touched-gc task, we should see that two of
@ -494,11 +498,11 @@
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (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) (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})] :deleted-at nil})]
(t/is (= (count rows) 2))) (t/is (= (count rows) 1)))
;; retrieve file and check trimmed attribute ;; retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})] (let [row (th/db-get :file {:id (:id file)})]
@ -535,11 +539,11 @@
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (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) (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
:deleted-at nil})] :deleted-at nil})]
(t/is (= (count rows) 3))) (t/is (= (count rows) 1)))
;; Now that file-gc have deleted the file-media-object usage, ;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of ;; 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 ;; thumbnail lets execute the objects-gc task which remove
;; the rows and mark as touched the storage object rows ;; the rows and mark as touched the storage object rows
(let [res (th/run-task! :objects-gc {:min-age 0})] (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 ;; Now that objects-gc have deleted the object thumbnail lets
;; execute the touched-gc task ;; execute the touched-gc task
@ -732,7 +736,7 @@
(let [res (th/run-task! :objects-gc {:min-age 0})] (let [res (th/run-task! :objects-gc {:min-age 0})]
;; (pp/pprint res) ;; (pp/pprint res)
(t/is (= 2 (:processed res)))) (t/is (= 3 (:processed res))))
;; We still have th storage objects in the table ;; We still have th storage objects in the table
(let [rows (th/db-query :storage-object {:deleted-at nil})] (let [rows (th/db-query :storage-object {:deleted-at nil})]
@ -1127,9 +1131,9 @@
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; check that object thumbnails are still here ;; check that object thumbnails are still here
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (th/print-result! res) ;; (app.common.pprint/pprint rows)
(t/is (= 1 (count res)))) (t/is (= 1 (count rows))))
;; insert object snapshot for for unknown frame ;; insert object snapshot for for unknown frame
(let [data {::th/type :create-file-object-thumbnail (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)]) (th/db-exec! ["update file set has_media_trimmed=false where id=?" (:id file)])
;; check that we have all object thumbnails ;; check that we have all object thumbnails
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count res)))) ;; (app.common.pprint/pprint rows)
(t/is (= 2 (count rows))))
;; run the task again ;; run the task again
(let [res (th/run-task! :file-gc {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (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 ;; check that the unknown frame thumbnail is deleted
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count rows))) (t/is (= 2 (count rows)))
(t/is (= 1 (count (remove :deleted-at rows))))) (t/is (= 1 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})] (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)})] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 1 (count rows))))))) (t/is (= 1 (count rows)))))))
(t/deftest file-thumbnail-ops (t/deftest file-thumbnail-ops
@ -1220,7 +1232,3 @@
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})] (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows))))))) (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)))) (t/is (= 1 (:processed result))))
(let [result (th/run-task! :objects-gc {:min-age 0})] (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 ;; check if row2 related thumbnail row still exists
(let [[row :as rows] (th/db-query :file-tagged-object-thumbnail (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 (ns backend-tests.rpc-profile-test
(:require (:require
[app.auth :as auth]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
[app.tokens :as tokens] [app.tokens :as tokens]
@ -126,7 +127,7 @@
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))))))) (t/is (nil? (:error out)))))))
(t/deftest profile-deletion-simple (t/deftest profile-deletion-1
(let [prof (th/create-profile* 1) (let [prof (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id prof) file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof) :project-id (:default-project-id prof)
@ -152,23 +153,22 @@
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= 1 (count (:result out))))) (t/is (= 1 (count (:result out)))))
;; execute permanent deletion task (th/run-pending-tasks!)
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(let [row (th/db-get :team
{:id (:default-team-id prof)}
{::db/remove-deleted false})]
(t/is (nil? (:deleted-at row))))
(let [result (th/run-task! :orphan-teams-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(let [row (th/db-get :team (let [row (th/db-get :team
{:id (:default-team-id prof)} {:id (:default-team-id prof)}
{::db/remove-deleted false})] {::db/remove-deleted false})]
(t/is (dt/instant? (:deleted-at row)))) (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 ;; query profile after delete
(let [params {::th/type :get-profile (let [params {::th/type :get-profile
::rpc/profile-id (:id prof)} ::rpc/profile-id (:id prof)}
@ -177,14 +177,187 @@
(let [result (:result out)] (let [result (:result out)]
(t/is (= uuid/zero (:id result))))))) (t/is (= uuid/zero (:id result)))))))
(t/deftest registration-domain-whitelist (t/deftest profile-deletion-2
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}] (let [prof1 (th/create-profile* 1)
(t/testing "allowed email domain" prof2 (th/create-profile* 2)
(t/is (true? (auth/email-domain-in-whitelist? whitelist "username@ya.ru"))) file1 (th/create-file* 1 {:profile-id (:id prof1)
(t/is (true? (auth/email-domain-in-whitelist? #{} "username@somedomain.com")))) :project-id (:default-project-id prof1)
:is-shared false})
team1 (th/create-team* 1 {:profile-id (:id prof1)})
(t/testing "not allowed email domain" role1 (th/create-team-role* {:team-id (:id team1)
(t/is (false? (auth/email-domain-in-whitelist? whitelist "username@somedomain.com")))))) :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 (t/deftest prepare-register-and-register-profile-1
(let [data {::th/type :prepare-register-profile (let [data {::th/type :prepare-register-profile
@ -417,9 +590,10 @@
(th/create-global-complaint-for pool {:type :bounce :email "user@example.com"}) (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
(let [out (th/command! data)] (let [out (th/command! data)]
(t/is (th/success? out)) (t/is (not (th/success? out)))
(let [result (:result out)] (let [edata (-> out :error ex-data)]
(t/is (contains? result :token)))))) (t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata)))))))
(t/deftest register-profile-with-complained-email (t/deftest register-profile-with-complained-email
(let [pool (:app.db/pool th/*system*) (let [pool (:app.db/pool th/*system*)
@ -430,9 +604,11 @@
(th/create-global-complaint-for pool {:type :complaint :email "user@example.com"}) (th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
(let [out (th/command! data)] (let [out (th/command! data)]
(t/is (th/success? out)) (t/is (not (th/success? out)))
(let [result (:result out)]
(t/is (contains? result :token)))))) (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 (t/deftest register-profile-with-email-as-password
(let [data {::th/type :prepare-register-profile (let [data {::th/type :prepare-register-profile
@ -463,20 +639,26 @@
;; with complaints ;; with complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email data)}) (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) ;; (th/print-result! out)
(t/is (nil? (: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 ;; with bounces
(th/create-global-complaint-for pool {:type :bounce :email (:email data)}) (th/create-global-complaint-for pool {:type :bounce :email (:email data)})
(let [out (th/command! data) (let [out (th/command! data)]
error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation)) (let [edata (-> out :error ex-data)]
(t/is (th/ex-of-code? error :email-has-permanent-bounces)) (t/is (= :restriction (:type edata)))
(t/is (= 2 (:call-count @mock))))))) (t/is (= :email-has-permanent-bounces (:code edata))))
(t/is (= 1 (:call-count @mock)))))))
(t/deftest email-change-request-without-smtp (t/deftest email-change-request-without-smtp
@ -541,7 +723,7 @@
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (: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 ;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)}) (th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
@ -550,7 +732,7 @@
(t/is (nil? (:result out))) (t/is (nil? (:result out)))
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (= 2 (:call-count @mock)))))))) (t/is (= 1 (:call-count @mock))))))))
(t/deftest update-profile-password (t/deftest update-profile-password

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

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

28
backend/yarn.lock
View file

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

18
common/deps.edn
View file

@ -1,10 +1,10 @@
{:deps {:deps
{org.clojure/clojure {:mvn/version "1.11.2"} {org.clojure/clojure {:mvn/version "1.11.2"}
org.clojure/data.json {:mvn/version "2.5.0"} 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/clojurescript {:mvn/version "1.11.132"}
org.clojure/test.check {:mvn/version "1.1.1"} 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 ;; Logging
org.apache.logging.log4j/log4j-api {:mvn/version "2.23.1"} 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-web {:mvn/version "2.23.1"}
org.apache.logging.log4j/log4j-jul {: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.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"} 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"} criterium/criterium {:mvn/version "0.4.6"}
metosin/jsonista {:mvn/version "0.3.8"} 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"} expound/expound {:mvn/version "0.9.0"}
com.cognitect/transit-clj {:mvn/version "1.0.333"} com.cognitect/transit-clj {:mvn/version "1.0.333"}
@ -28,7 +28,7 @@
integrant/integrant {:mvn/version "0.8.1"} integrant/integrant {:mvn/version "0.8.1"}
org.apache.commons/commons-pool2 {:mvn/version "2.12.0"} 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/tubax {:mvn/version "2021.05.20-0"}
funcool/cuerdas {:mvn/version "2023.11.09-407"} funcool/cuerdas {:mvn/version "2023.11.09-407"}
@ -63,7 +63,7 @@
{:dev {:dev
{:extra-deps {:extra-deps
{org.clojure/tools.namespace {:mvn/version "RELEASE"} {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.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
com.bhauman/rebel-readline {:mvn/version "RELEASE"} com.bhauman/rebel-readline {:mvn/version "RELEASE"}
criterium/criterium {:mvn/version "RELEASE"} criterium/criterium {:mvn/version "RELEASE"}
@ -72,12 +72,12 @@
:build :build
{:extra-deps {: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} :ns-default build}
:test :test
{:main-opts ["-m" "kaocha.runner"] {: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 :shadow-cljs
{:main-opts ["-m" "shadow.cljs.devtools.cli"]} {:main-opts ["-m" "shadow.cljs.devtools.cli"]}

10
common/package.json
View file

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

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

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

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

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

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