Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-18 10:41:29 -05:00
Code Issues Activity

Merge branch 'staging' into main

Browse source
This commit is contained in:
Andrey Antukh 2021-05-26 10:36:12 +02:00
commit bd8aa8163d
247 changed files with 14159 additions and 3735 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -26,6 +26,7 @@ node_modules
/frontend/out/
/frontend/.shadow-cljs
/frontend/resources/public/*
/frontend/resources/fonts/experiments
/exporter/target
/exporter/.shadow-cljs
/docker/images/bundle*

45
CHANGES.md
View file

@ -1,14 +1,59 @@
# CHANGELOG #
## :rocket: Next
### :sparkles: New features
### :bug: Bugs fixed
### :arrow_up: Deps updates
### :boom: Breaking changes
### :heart: Community contributions by (Thank you!)
## 1.6.0-alpha
### :sparkles: New features
- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
- Add option to interactively scale text [Taiga #1527](https://tree.taiga.io/project/penpot/us/1527)
- Add performance improvements on dashboard data loading.
- Add performance improvements to indexes handling on workspace.
- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
- Transform shapes to path on double click
- Translate automatic names of new files and projects.
- Use shift instead of ctrl/cmd to keep aspect ratio [Taiga 1697](https://tree.taiga.io/project/penpot/issue/1697).
- New translations: Portuguese (Brazil) and Romanias.
### :bug: Bugs fixed
- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656).
- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940).
- Fix problem with imported SVG on editing paths [#971](https://github.com/penpot/penpot/issues/971)
- Fix problem with color picker positioning
- Fix order on color palette [#961](https://github.com/penpot/penpot/issues/961)
- Fix issue when group creation leaves an empty group [#1724](https://tree.taiga.io/project/penpot/issue/1724)
- Fix problem with :multiple for colors and typographies [#1668](https://tree.taiga.io/project/penpot/issue/1668)
- Fix problem with locked shapes when change parents [#974](https://github.com/penpot/penpot/issues/974)
### :arrow_up: Deps updates
- Update exporter dependencies (puppeteer), that fixes some unexpected exceptions.
- Update string manipulation library.
### :boom: Breaking changes
- The OIDC setting `PENPOT_OIDC_SCOPES` has changed the default semantics. Before this
configuration added scopes to the default set. Now it replaces it, so use with care, because
penpot requires at least `name` and `email` props found on the user info object.
### :heart: Community contributions by (Thank you!)
- Translations: Portuguese (Brazil) and Romanias.
## 1.5.4-alpha
### :bug: Bugs fixed

36
backend/deps.edn
View file

@ -4,8 +4,8 @@
"jcenter" {:url "https://jcenter.bintray.com/"}}
:deps
{org.clojure/clojure {:mvn/version "1.10.3"}
org.clojure/data.json {:mvn/version "2.2.1"}
org.clojure/core.async {:mvn/version "1.3.610"}
org.clojure/data.json {:mvn/version "2.2.3"}
org.clojure/core.async {:mvn/version "1.3.618"}
org.clojure/tools.cli {:mvn/version "1.0.206"}
org.clojure/clojurescript {:mvn/version "1.10.844"}
@ -32,28 +32,28 @@
org.eclipse.jetty/jetty-servlet]}
io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
selmer/selmer {:mvn/version "1.12.33"}
selmer/selmer {:mvn/version "1.12.40"}
expound/expound {:mvn/version "0.8.9"}
com.cognitect/transit-clj {:mvn/version "1.0.324"}
io.lettuce/lettuce-core {:mvn/version "6.1.1.RELEASE"}
io.lettuce/lettuce-core {:mvn/version "6.1.2.RELEASE"}
java-http-clj/java-http-clj {:mvn/version "0.4.2"}
info.sunng/ring-jetty9-adapter {:mvn/version "0.15.1"}
com.github.seancorfield/next.jdbc {:mvn/version "1.1.646"}
metosin/reitit-ring {:mvn/version "0.5.12"}
metosin/jsonista {:mvn/version "0.3.1"}
com.github.seancorfield/next.jdbc {:mvn/version "1.2.659"}
metosin/reitit-ring {:mvn/version "0.5.13"}
metosin/jsonista {:mvn/version "0.3.3"}
org.postgresql/postgresql {:mvn/version "42.2.19"}
org.postgresql/postgresql {:mvn/version "42.2.20"}
com.zaxxer/HikariCP {:mvn/version "4.0.3"}
funcool/datoteka {:mvn/version "1.2.0"}
funcool/promesa {:mvn/version "6.0.0"}
funcool/cuerdas {:mvn/version "2020.03.26-3"}
funcool/datoteka {:mvn/version "2.0.0"}
funcool/promesa {:mvn/version "6.0.1"}
funcool/cuerdas {:mvn/version "2021.05.09-0"}
buddy/buddy-core {:mvn/version "1.9.0"}
buddy/buddy-hashers {:mvn/version "1.7.0"}
buddy/buddy-sign {:mvn/version "3.3.0"}
buddy/buddy-core {:mvn/version "1.10.1"}
buddy/buddy-hashers {:mvn/version "1.8.1"}
buddy/buddy-sign {:mvn/version "3.4.1"}
lambdaisland/uri {:mvn/version "1.4.54"
:exclusions [org.clojure/data.json]}
@ -69,7 +69,7 @@
org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
integrant/integrant {:mvn/version "0.8.0"}
software.amazon.awssdk/s3 {:mvn/version "2.16.44"}
software.amazon.awssdk/s3 {:mvn/version "2.16.62"}
;; exception printing
io.aviso/pretty {:mvn/version "0.1.37"}
@ -78,9 +78,9 @@
:aliases
{:dev
{:extra-deps
{com.bhauman/rebel-readline {:mvn/version "0.1.4"}
org.clojure/tools.namespace {:mvn/version "1.1.0"}
org.clojure/test.check {:mvn/version "1.1.0"}
{com.bhauman/rebel-readline {:mvn/version "RELEASE"}
org.clojure/tools.namespace {:mvn/version "RELEASE"}
org.clojure/test.check {:mvn/version "RELEASE"}
fipp/fipp {:mvn/version "0.6.23"}
criterium/criterium {:mvn/version "0.4.6"}

11
backend/resources/log4j2-devenv.xml
View file

@ -12,6 +12,11 @@
</Policies>
<DefaultRolloverStrategy max="9"/>
</RollingFile>
<JeroMQ name="zmq">
<Property name="endpoint">tcp://localhost:45556</Property>
<JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
</JeroMQ>
</Appenders>
<Loggers>
@ -30,10 +35,12 @@
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
<AppenderRef ref="zmq" level="debug" />
</Logger>
<Logger name="penpot" level="fatal" additivity="false">
<AppenderRef ref="main" level="fatal" />
<Logger name="penpot" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" />
<AppenderRef ref="zmq" level="debug" />
</Logger>
<Logger name="user" level="trace" additivity="false">

4
backend/scripts/repl
View file

@ -2,7 +2,9 @@
export PENPOT_ASSERTS_ENABLED=true
export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Xms512m -J-Xmx512m -J-Dlog4j2.configurationFile=log4j2-devenv.xml"
export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Dlog4j2.configurationFile=log4j2-devenv.xml -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
# export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
# export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
export OPTIONS_EVAL="nil"
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

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

@ -8,6 +8,8 @@
"A configuration management."
(:refer-clojure :exclude [get])
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.version :as v]
[app.util.time :as dt]
@ -16,7 +18,8 @@
[clojure.pprint :as pprint]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[environ.core :refer [env]]))
[environ.core :refer [env]]
[integrant.core :as ig]))
(prefer-method print-method
clojure.lang.IRecord
@ -26,6 +29,16 @@
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(defmethod ig/init-key :default
[_ data]
(d/without-nils data))
(defmethod ig/prep-key :default
[_ data]
(if (map? data)
(d/without-nils data)
data))
(def defaults
{:http-server-port 6060
:host "devenv"
@ -34,8 +47,7 @@
:database-username "penpot"
:database-password "penpot"
:default-blob-version 1
:default-blob-version 3
:loggers-zmq-uri "tcp://localhost:45556"
:asserts-enabled false
@ -72,7 +84,6 @@
:allow-demo-users true
:registration-enabled true
:registration-domain-whitelist ""
:telemetry-enabled false
:telemetry-uri "https://telemetry.penpot.app/"
@ -87,6 +98,13 @@
:initial-project-skey "initial-project"
})
(s/def ::audit-enabled ::us/boolean)
(s/def ::audit-archive-enabled ::us/boolean)
(s/def ::audit-archive-uri ::us/string)
(s/def ::audit-archive-gc-enabled ::us/boolean)
(s/def ::audit-archive-gc-max-age ::dt/duration)
(s/def ::secret-key ::us/string)
(s/def ::allow-demo-users ::us/boolean)
(s/def ::asserts-enabled ::us/boolean)
(s/def ::assets-path ::us/string)
@ -142,7 +160,7 @@
(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/string)
(s/def ::registration-domain-whitelist ::us/set-of-str)
(s/def ::registration-enabled ::us/boolean)
(s/def ::rlimits-image ::us/integer)
(s/def ::rlimits-password ::us/integer)
@ -162,14 +180,18 @@
(s/def ::storage-s3-bucket ::us/string)
(s/def ::storage-s3-region ::us/keyword)
(s/def ::telemetry-enabled ::us/boolean)
(s/def ::telemetry-server-enabled ::us/boolean)
(s/def ::telemetry-server-port ::us/integer)
(s/def ::telemetry-uri ::us/string)
(s/def ::telemetry-with-taiga ::us/boolean)
(s/def ::tenant ::us/string)
(s/def ::config
(s/keys :opt-un [::allow-demo-users
(s/keys :opt-un [::secret-key
::allow-demo-users
::audit-enabled
::audit-archive-enabled
::audit-archive-uri
::audit-archive-gc-enabled
::audit-archive-gc-max-age
::asserts-enabled
::database-password
::database-uri
@ -242,8 +264,6 @@
::storage-s3-bucket
::storage-s3-region
::telemetry-enabled
::telemetry-server-enabled
::telemetry-server-port
::telemetry-uri
::telemetry-referer
::telemetry-with-taiga
@ -263,9 +283,17 @@
(defn- read-config
[]
(->> (read-env "penpot")
(merge defaults)
(us/conform ::config)))
(try
(->> (read-env "penpot")
(merge defaults)
(us/conform ::config))
(catch Throwable e
(when (ex/ex-info? e)
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
(println "Error on validating configuration:")
(println (:explain (ex-data e))
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
(throw e))))
(def version (v/parse (or (some-> (io/resource "version.txt")
(slurp)

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

@ -200,6 +200,13 @@
(sql/insert table params opts)
(assoc opts :return-keys true))))
(defn insert-multi!
([ds table cols rows] (insert-multi! ds table cols rows nil))
([ds table cols rows opts]
(exec! ds
(sql/insert-multi table cols rows opts)
(assoc opts :return-keys true))))
(defn update!
([ds table params where] (update! ds table params where nil))
([ds table params where opts]
@ -326,6 +333,12 @@
(t/decode-str val)
val)))
(defn inet
[ip-addr]
(doto (org.postgresql.util.PGobject.)
(.setType "inet")
(.setValue (str ip-addr))))
(defn tjson
"Encode as transit json."
[data]

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

@ -32,6 +32,11 @@
(assoc :suffix "ON CONFLICT DO NOTHING"))]
(sql/for-insert table key-map opts))))
(defn insert-multi
[table cols rows opts]
(let [opts (merge default-opts opts)]
(sql/for-insert-multi table cols rows opts)))
(defn select
([table where-params]
(select table where-params nil))

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

@ -76,6 +76,7 @@
{:status 500
:body {:type :server-error
:code :assertion
:data (-> edata
(assoc :explain (explain-error edata))
(dissoc :data))}}))
@ -103,6 +104,7 @@
:cause error)
{:status 500
:body {:type :server-error
:code :unexpected
:hint (ex-message error)
:data edata}}))))
@ -132,7 +134,8 @@
:else
{:status 500
:body {:type :server-timeout
:body {:type :server-error
:code :psql-exception
:hint (ex-message error)
:state state}})))

47
backend/src/app/http/oauth.clj
View file

@ -98,10 +98,11 @@
res (http/send! req)]
(when (= 200 (:status res))
(let [{:keys [name] :as data} (json/read-str (:body res) :key-fn keyword)]
(-> data
(assoc :backend (:name provider))
(assoc :fullname name)))))
(let [info (json/read-str (:body res) :key-fn keyword)]
{:backend (:name provider)
:email (:email info)
:fullname (:name info)
:props (dissoc info :name :email)})))
(catch Exception e
(l/error :hint "unexpected exception on retrieve-user-info"
@ -117,7 +118,8 @@
(retrieve-user-info cfg))]
(when-not info
(ex/raise :type :internal
:code :unable-to-auth))
:code :unable-to-auth
:hint "no user info"))
;; If the provider is OIDC, we can proceed to check
;; roles if they are defined.
@ -138,16 +140,35 @@
(cond-> info
(some? (:invitation-token state))
(assoc :invitation-token (:invitation-token state)))))
(assoc :invitation-token (:invitation-token state))
;; If state token comes with props, merge them. The state token
;; props can contain pm_ and utm_ prefixed query params.
(map? (:props state))
(update :props merge (:props state)))))
;; --- HTTP HANDLERS
(defn extract-props
[params]
(reduce-kv (fn [params k v]
(let [sk (name k)]
(cond-> params
(or (str/starts-with? sk "pm_")
(str/starts-with? sk "pm-")
(str/starts-with? sk "utm_"))
(assoc (-> sk str/kebab keyword) v))))
{}
params))
(defn- auth-handler
[{:keys [tokens] :as cfg} request]
(let [invitation (get-in request [:params :invitation-token])
[{:keys [tokens] :as cfg} {:keys [params] :as request}]
(let [invitation (:invitation-token params)
props (extract-props params)
state (tokens :generate
{:iss :oauth
:invitation-token invitation
:props props
:exp (dt/in-future "15m")})
uri (build-auth-uri cfg state)]
{:status 200
@ -215,8 +236,7 @@
:token-uri (cf/get :oidc-token-uri)
:auth-uri (cf/get :oidc-auth-uri)
:user-uri (cf/get :oidc-user-uri)
:scopes (into #{"openid" "profile" "email" "name"}
(cf/get :oidc-scopes #{}))
:scopes (cf/get :oidc-scopes #{"openid" "profile"})
:roles-attr (cf/get :oidc-roles-attr)
:roles (cf/get :oidc-roles)
:name "oidc"}]
@ -238,9 +258,7 @@
[cfg]
(let [opts {:client-id (cf/get :google-client-id)
:client-secret (cf/get :google-client-secret)
:scopes #{"email" "profile" "openid"
"https://www.googleapis.com/auth/userinfo.email"
"https://www.googleapis.com/auth/userinfo.profile"}
:scopes #{"openid" "email" "profile"}
:auth-uri "https://accounts.google.com/o/oauth2/v2/auth"
:token-uri "https://oauth2.googleapis.com/token"
:user-uri "https://openidconnect.googleapis.com/v1/userinfo"
@ -256,8 +274,7 @@
[cfg]
(let [opts {:client-id (cf/get :github-client-id)
:client-secret (cf/get :github-client-secret)
:scopes #{"read:user"
"user:email"}
:scopes #{"read:user" "user:email"}
:auth-uri "https://github.com/login/oauth/authorize"
:token-uri "https://github.com/login/oauth/access_token"
:user-uri "https://api.github.com/user"

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

@ -106,7 +106,6 @@
;; --- STATE INIT: SESSION UPDATER
(declare batch-events)
(declare update-sessions)
(s/def ::session map?)
@ -129,7 +128,9 @@
(l/info :action "initialize session updater"
:max-batch-age (str (:max-batch-age cfg))
:max-batch-size (str (:max-batch-size cfg)))
(let [input (batch-events cfg (::events-ch session))
(let [input (aa/batch (::events-ch session)
{:max-batch-size (:max-batch-size cfg)
:max-batch-age (inst-ms (:max-batch-age cfg))})
mcnt (mtx/create
{:name "http_session_update_total"
:help "A counter of session update batch events."
@ -149,36 +150,6 @@
:count result))
(recur))))))
(defn- timeout-chan
[cfg]
(a/timeout (inst-ms (:max-batch-age cfg))))
(defn- batch-events
[cfg in]
(let [out (a/chan)]
(a/go-loop [tch (timeout-chan cfg)
buf #{}]
(let [[val port] (a/alts! [tch in])]
(cond
(identical? port tch)
(if (empty? buf)
(recur (timeout-chan cfg) buf)
(do
(a/>! out [:timeout buf])
(recur (timeout-chan cfg) #{})))
(nil? val)
(a/close! out)
(identical? port in)
(let [buf (conj buf val)]
(if (>= (count buf) (:max-batch-size cfg))
(do
(a/>! out [:size buf])
(recur (timeout-chan cfg) #{}))
(recur tch buf))))))
out))
(defn- update-sessions
[{:keys [pool executor]} ids]
(aa/with-thread executor

232
backend/src/app/loggers/audit.clj Normal file
View file

@ -0,0 +1,232 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.loggers.audit
"Services related to the user activity (audit log)."
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.util.async :as aa]
[app.util.http :as http]
[app.util.logging :as l]
[app.util.time :as dt]
[app.util.transit :as t]
[app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[lambdaisland.uri :as u]))
(defn clean-props
[{:keys [profile-id] :as event}]
(letfn [(clean-common [props]
(-> props
(dissoc :session-id)
(dissoc :password)
(dissoc :old-password)
(dissoc :token)))
(clean-profile-id [props]
(cond-> props
(= profile-id (:profile-id props))
(dissoc :profile-id)))
(clean-complex-data [props]
(reduce-kv (fn [props k v]
(cond-> props
(or (string? v)
(uuid? v)
(boolean? v)
(number? v))
(assoc k v)
(keyword? v)
(assoc k (name v))))
{}
props))]
(update event :props #(-> % clean-common clean-profile-id clean-complex-data))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collector
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Defines a service that collects the audit/activity log using
;; internal database. Later this audit log can be transferred to
;; an external storage and data cleared.
(declare persist-events)
(s/def ::enabled ::us/boolean)
(defmethod ig/pre-init-spec ::collector [_]
(s/keys :req-un [::db/pool ::wrk/executor ::enabled]))
(def event-xform
(comp
(filter :profile-id)
(map clean-props)))
(defmethod ig/init-key ::collector
[_ {:keys [enabled] :as cfg}]
(when enabled
(l/info :msg "intializing audit collector")
(let [input (a/chan 1 event-xform)
buffer (aa/batch input {:max-batch-size 100
:max-batch-age (* 5 1000)
:init []})]
(a/go-loop []
(when-let [[type events] (a/<! buffer)]
(l/debug :action "persist-events (batch)"
:reason (name type)
:count (count events))
(let [res (a/<! (persist-events cfg events))]
(when (ex/exception? res)
(l/error :hint "error on persiting events"
:cause res)))
(recur)))
(fn [& [cmd & params]]
(case cmd
:stop (a/close! input)
:submit (when-not (a/offer! input (first params))
(l/warn :msg "activity channel is full")))))))
(defn- persist-events
[{:keys [pool executor] :as cfg} events]
(letfn [(event->row [event]
[(uuid/next)
(:name event)
(:type event)
(:profile-id event)
(db/tjson (:props event))])]
(aa/with-thread executor
(db/with-atomic [conn pool]
(db/insert-multi! conn :audit-log
[:id :name :type :profile-id :props]
(sequence (map event->row) events))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Archive Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is a task responsible to send the accomulated events to an
;; external service for archival.
(declare archive-events)
(s/def ::uri ::us/string)
(s/def ::tokens fn?)
(defmethod ig/pre-init-spec ::archive-task [_]
(s/keys :req-un [::db/pool ::tokens ::enabled]
:opt-un [::uri]))
(defmethod ig/init-key ::archive-task
[_ {:keys [uri enabled] :as cfg}]
(fn [_]
(when (and enabled (not uri))
(ex/raise :type :internal
:code :task-not-configured
:hint "archive task not configured, missing uri"))
(loop []
(let [res (archive-events cfg)]
(when (= res :continue)
(aa/thread-sleep 200)
(recur))))))
(def sql:retrieve-batch-of-audit-log
"select * from audit_log
where archived_at is null
order by created_at asc
limit 100
for update skip locked;")
(defn archive-events
[{:keys [pool uri tokens] :as cfg}]
(letfn [(decode-row [{:keys [props] :as row}]
(cond-> row
(db/pgobject? props)
(assoc :props (db/decode-transit-pgobject props))))
(row->event [{:keys [name type created-at profile-id props]}]
{:type type
:name name
:timestamp created-at
:profile-id profile-id
:props props})
(send [events]
(let [token (tokens :generate {:iss "authentication"
:iat (dt/now)
:uid uuid/zero})
body (t/encode {:events events})
headers {"content-type" "application/transit+json"
"origin" (cf/get :public-uri)
"cookie" (u/map->query-string {:auth-token token})}
params {:uri uri
:timeout 5000
:method :post
:headers headers
:body body}
resp (http/send! params)]
(when (not= (:status resp) 204)
(ex/raise :type :internal
:code :unable-to-send-events
:hint "unable to send events"
:context resp))))
(mark-as-archived [conn rows]
(db/exec-one! conn ["update audit_log set archived_at=now() where id = ANY(?)"
(->> (map :id rows)
(into-array java.util.UUID)
(db/create-array conn "uuid"))]))]
(db/with-atomic [conn pool]
(let [rows (db/exec! conn [sql:retrieve-batch-of-audit-log])
xform (comp (map decode-row)
(map row->event))
events (into [] xform rows)]
(l/debug :action "archive-events" :uri uri :events (count events))
(if (empty? events)
:empty
(do
(send events)
(mark-as-archived conn rows)
:continue))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GC Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare clean-archived)
(s/def ::max-age ::cf/audit-archive-gc-max-age)
(defmethod ig/pre-init-spec ::archive-gc-task [_]
(s/keys :req-un [::db/pool ::enabled ::max-age]))
(defmethod ig/init-key ::archive-gc-task
[_ cfg]
(fn [_]
(clean-archived cfg)))
(def sql:clean-archived
"delete from audit_log
where archived_at is not null
and archived_at < now() - ?::interval")
(defn- clean-archived
[{:keys [pool max-age]}]
(let [interval (db/interval max-age)
result (db/exec-one! pool [sql:clean-archived interval])
result (:next.jdbc/update-count result)]
(l/debug :action "clean archived audit log" :removed result)
result))

8
backend/src/app/loggers/loki.clj
View file

@ -31,16 +31,16 @@
[_ {:keys [receiver uri] :as cfg}]
(when uri
(l/info :msg "intializing loki reporter" :uri uri)
(let [output (a/chan (a/sliding-buffer 1024))]
(receiver :sub output)
(let [input (a/chan (a/sliding-buffer 1024))]
(receiver :sub input)
(a/go-loop []
(let [msg (a/<! output)]
(let [msg (a/<! input)]
(if (nil? msg)
(l/info :msg "stoping error reporting loop")
(do
(a/<! (handle-event cfg msg))
(recur)))))
output)))
input)))
(defmethod ig/halt-key! ::reporter
[_ output]

2
backend/src/app/loggers/mattermost.clj
View file

@ -58,7 +58,7 @@
(a/close! output))
(defn- send-mattermost-notification!
[cfg {:keys [host version id error] :as cdata}]
[cfg {:keys [host version id] :as cdata}]
(try
(let [uri (:uri cfg)
text (str "Unhandled exception (@channel):\n"

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

@ -6,7 +6,6 @@
(ns app.main
(:require
[app.common.data :as d]
[app.config :as cf]
[app.util.logging :as l]
[app.util.time :as dt]
@ -45,7 +44,7 @@
:redis-uri (cf/get :redis-uri)}
:app.tokens/tokens
{:sprops (ig/ref :app.setup/props)}
{:props (ig/ref :app.setup/props)}
:app.storage/gc-deleted-task
{:pool (ig/ref :app.db/pool)
@ -122,10 +121,15 @@
:app.rlimits/image
(cf/get :rlimits-image)
;; RLimit definition for font processing
:app.rlimits/font
(cf/get :rlimits-font 2)
;; A collection of rlimits as hash-map.
:app.rlimits/all
{:password (ig/ref :app.rlimits/password)
:image (ig/ref :app.rlimits/image)}
:image (ig/ref :app.rlimits/image)
:font (ig/ref :app.rlimits/font)}
:app.rpc/rpc
{:pool (ig/ref :app.db/pool)
@ -135,7 +139,8 @@
:storage (ig/ref :app.storage/storage)
:msgbus (ig/ref :app.msgbus/msgbus)
:rlimits (ig/ref :app.rlimits/all)
:public-uri (cf/get :public-uri)}
:public-uri (cf/get :public-uri)
:audit (ig/ref :app.loggers.audit/collector)}
:app.notifications/handler
{:msgbus (ig/ref :app.msgbus/msgbus)
@ -182,6 +187,14 @@
{:cron #app/cron "0 0 0 */1 * ?" ;; daily
:task :tasks-gc}
(when (cf/get :audit-archive-enabled)
{:cron #app/cron "0 0 * * * ?" ;; every 1h
:task :audit-archive})
(when (cf/get :audit-archive-gc-enabled)
{:cron #app/cron "0 0 * * * ?" ;; every 1h
:task :audit-archive-gc})
(when (cf/get :telemetry-enabled)
{:cron #app/cron "0 0 */6 * * ?" ;; every 6h
:task :telemetry})]}
@ -199,7 +212,9 @@
:storage-recheck (ig/ref :app.storage/recheck-task)
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
:telemetry (ig/ref :app.tasks.telemetry/handler)
:session-gc (ig/ref :app.http.session/gc-task)}}
:session-gc (ig/ref :app.http.session/gc-task)
:audit-archive (ig/ref :app.loggers.audit/archive-task)
:audit-archive-gc (ig/ref :app.loggers.audit/archive-gc-task)}}
:app.emails/sendmail-handler
{:host (cf/get :smtp-host)
@ -215,7 +230,7 @@
:app.tasks.tasks-gc/handler
{:pool (ig/ref :app.db/pool)
:max-age (dt/duration {:hours 24})
:max-age cf/deletion-delay
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.delete-object/handler
@ -234,12 +249,12 @@
:app.tasks.file-media-gc/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)
:max-age (dt/duration {:hours 48})}
:max-age cf/deletion-delay}
:app.tasks.file-xlog-gc/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)
:max-age (dt/duration {:hours 48})}
:max-age cf/deletion-delay}
:app.tasks.telemetry/handler
{:pool (ig/ref :app.db/pool)
@ -252,11 +267,28 @@
:host (cf/get :srepl-host)}
:app.setup/props
{:pool (ig/ref :app.db/pool)}
{:pool (ig/ref :app.db/pool)
:key (cf/get :secret-key)}
:app.loggers.zmq/receiver
{:endpoint (cf/get :loggers-zmq-uri)}
:app.loggers.audit/collector
{:enabled (cf/get :audit-enabled false)
:pool (ig/ref :app.db/pool)
:executor (ig/ref :app.worker/executor)}
:app.loggers.audit/archive-task
{:uri (cf/get :audit-archive-uri)
:enabled (cf/get :audit-archive-enabled false)
:tokens (ig/ref :app.tokens/tokens)
:pool (ig/ref :app.db/pool)}
:app.loggers.audit/archive-gc-task
{:enabled (cf/get :audit-archive-gc-enabled false)
:max-age (cf/get :audit-archive-gc-max-age cf/deletion-delay)
:pool (ig/ref :app.db/pool)}
:app.loggers.loki/reporter
{:uri (cf/get :loggers-loki-uri)
:receiver (ig/ref :app.loggers.zmq/receiver)
@ -293,13 +325,6 @@
[::main :app.storage.db/backend]
{:pool (ig/ref :app.db/pool)}})
(defmethod ig/init-key :default [_ data] data)
(defmethod ig/prep-key :default
[_ data]
(if (map? data)
(d/without-nils data)
data))
(def system nil)
(defn start

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

@ -5,7 +5,7 @@
;; Copyright (c) UXBOX Labs SL
(ns app.media
"Media postprocessing."
"Media & Font postprocessing."
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
@ -13,20 +13,31 @@
[app.common.spec :as us]
[app.rlimits :as rlm]
[app.rpc.queries.svg :as svg]
[buddy.core.bytes :as bb]
[buddy.core.codecs :as bc]
[clojure.java.io :as io]
[clojure.java.shell :as sh]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.core :as fs])
(:import
java.io.ByteArrayInputStream
java.io.OutputStream
org.apache.commons.io.IOUtils
org.im4java.core.ConvertCmd
org.im4java.core.IMOperation
org.im4java.core.Info))
;; --- Generic specs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::image-content-type cm/valid-image-types)
(s/def ::font-content-type cm/valid-font-types)
(s/def :internal.http.upload/filename ::us/string)
(s/def :internal.http.upload/size ::us/integer)
(s/def :internal.http.upload/content-type cm/valid-media-types)
(s/def :internal.http.upload/content-type ::us/string)
(s/def :internal.http.upload/tempfile any?)
(s/def ::upload
@ -35,8 +46,45 @@
:internal.http.upload/tempfile
:internal.http.upload/content-type]))
(defn validate-media-type
([mtype] (validate-media-type mtype cm/valid-image-types))
([mtype allowed]
(when-not (contains? allowed mtype)
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "Seems like you are uploading an invalid media object"))))
(defmulti process :cmd)
(defmulti process-error class)
(defmethod process :default
[{:keys [cmd] :as params}]
(ex/raise :type :internal
:code :not-implemented
:hint (str/fmt "No impl found for process cmd: %s" cmd)))
(defmethod process-error :default
[error]
(ex/raise :type :internal
:cause error))
(defn run
[{:keys [rlimits] :as cfg} {:keys [rlimit] :or {rlimit :image} :as params}]
(us/assert map? rlimits)
(let [rlimit (get rlimits rlimit)]
(when-not rlimit
(ex/raise :type :internal
:code :rlimit-not-configured
:hint ":image rlimit not configured"))
(try
(rlm/execute rlimit (process params))
(catch Throwable e
(process-error e)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Thumbnails Generation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::cmd keyword?)
@ -77,8 +125,6 @@
:size (alength ^bytes thumbnail-data)
:data (ByteArrayInputStream. thumbnail-data)))))
(defmulti process :cmd)
(defmethod process :generic-thumbnail
[{:keys [quality width height] :as params}]
(us/assert ::thumbnail-params params)
@ -161,33 +207,127 @@
:height (.getPageHeight instance)
:mtype mtype}))))
(defmethod process :default
[{:keys [cmd] :as params}]
(ex/raise :type :internal
:code :not-implemented
:hint (str "No impl found for process cmd:" cmd)))
(defmethod process-error org.im4java.core.InfoException
[error]
(ex/raise :type :validation
:code :invalid-image
:cause error))
(defn run
[{:keys [rlimits]} params]
(us/assert map? rlimits)
(let [rlimit (get rlimits :image)]
(when-not rlimit
(ex/raise :type :internal
:code :rlimit-not-configured
:hint ":image rlimit not configured"))
(try
(rlm/execute rlimit (process params))
(catch org.im4java.core.InfoException e
(ex/raise :type :validation
:code :invalid-image
:cause e)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Fonts Generation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Utility functions
(def all-fotmats #{"font/woff2", "font/woff", "font/otf", "font/ttf"})
(defn validate-media-type
([mtype] (validate-media-type mtype cm/valid-media-types))
([mtype allowed]
(when-not (contains? allowed mtype)
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "Seems like you are uploading an invalid media object"))))
(defmethod process :generate-fonts
[{:keys [input] :as params}]
(letfn [(ttf->otf [data]
(let [input-file (fs/create-tempfile :prefix "penpot")
output-file (fs/path (str input-file ".otf"))
_ (with-open [out (io/output-stream input-file)]
(IOUtils/writeChunked ^bytes data ^OutputStream out)
(.flush ^OutputStream out))
res (sh/sh "fontforge" "-lang=ff" "-c"
(str/fmt "Open('%s'); Generate('%s')"
(str input-file)
(str output-file)))]
(when (zero? (:exit res))
(fs/slurp-bytes output-file))))
(otf->ttf [data]
(let [input-file (fs/create-tempfile :prefix "penpot")
output-file (fs/path (str input-file ".ttf"))
_ (with-open [out (io/output-stream input-file)]
(IOUtils/writeChunked ^bytes data ^OutputStream out)
(.flush ^OutputStream out))
res (sh/sh "fontforge" "-lang=ff" "-c"
(str/fmt "Open('%s'); Generate('%s')"
(str input-file)
(str output-file)))]
(when (zero? (:exit res))
(fs/slurp-bytes output-file))))
(ttf-or-otf->woff [data]
(let [input-file (fs/create-tempfile :prefix "penpot" :suffix "")
output-file (fs/path (str input-file ".woff"))
_ (with-open [out (io/output-stream input-file)]
(IOUtils/writeChunked ^bytes data ^OutputStream out)
(.flush ^OutputStream out))
res (sh/sh "sfnt2woff" (str input-file))]
(when (zero? (:exit res))
(fs/slurp-bytes output-file))))
(ttf-or-otf->woff2 [data]
(let [input-file (fs/create-tempfile :prefix "penpot" :suffix "")
output-file (fs/path (str input-file ".woff2"))
_ (with-open [out (io/output-stream input-file)]
(IOUtils/writeChunked ^bytes data ^OutputStream out)
(.flush ^OutputStream out))
res (sh/sh "woff2_compress" (str input-file))]
(when (zero? (:exit res))
(fs/slurp-bytes output-file))))
(woff->sfnt [data]
(let [input-file (fs/create-tempfile :prefix "penpot" :suffix "")
_ (with-open [out (io/output-stream input-file)]
(IOUtils/writeChunked ^bytes data ^OutputStream out)
(.flush ^OutputStream out))
res (sh/sh "woff2sfnt" (str input-file)
:out-enc :bytes)]
(when (zero? (:exit res))
(:out res))))
;; Documented here:
;; https://docs.microsoft.com/en-us/typography/opentype/spec/otff#table-directory
(get-sfnt-type [data]
(let [buff (bb/slice data 0 4)
type (bc/bytes->hex buff)]
(case type
"4f54544f" :otf
"00010000" :ttf
(ex/raise :type :internal
:code :unexpected-data
:hint "unexpected font data"))))
(gen-if-nil [val factory]
(if (nil? val)
(factory)
val))]
(let [current (into #{} (keys input))]
(cond
(contains? current "font/ttf")
(let [data (get input "font/ttf")]
(-> input
(update "font/otf" gen-if-nil #(ttf->otf data))
(update "font/woff" gen-if-nil #(ttf-or-otf->woff data))
(assoc "font/woff2" (ttf-or-otf->woff2 data))))
(contains? current "font/otf")
(let [data (get input "font/otf")]
(-> input
(update "font/woff" gen-if-nil #(ttf-or-otf->woff data))
(assoc "font/ttf" (otf->ttf data))
(assoc "font/woff2" (ttf-or-otf->woff2 data))))
(contains? current "font/woff")
(let [data (get input "font/woff")
sfnt (woff->sfnt data)]
(when-not sfnt
(ex/raise :type :validation
:code :invalid-woff-file
:hint "invalid woff file"))
(let [stype (get-sfnt-type sfnt)]
(cond-> input
true
(-> (assoc "font/woff" data)
(assoc "font/woff2" (ttf-or-otf->woff2 sfnt)))
(= stype :otf)
(-> (assoc "font/otf" sfnt)
(assoc "font/ttf" (otf->ttf sfnt)))
(= stype :ttf)
(-> (assoc "font/otf" (ttf->otf sfnt))
(assoc "font/ttf" sfnt)))))))))

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

@ -166,6 +166,15 @@
{:name "0052-del-legacy-user-and-team"
:fn (mg/resource "app/migrations/sql/0052-del-legacy-user-and-team.sql")}
{:name "0053-add-team-font-variant-table"
:fn (mg/resource "app/migrations/sql/0053-add-team-font-variant-table.sql")}
{:name "0054-add-audit-log-table"
:fn (mg/resource "app/migrations/sql/0054-add-audit-log-table.sql")}
{:name "0055-mod-file-media-object-table"
:fn (mg/resource "app/migrations/sql/0055-mod-file-media-object-table.sql")}
])

10
backend/src/app/migrations/sql/0015-improve-tasks-tables.sql
View file

@ -1,4 +1,4 @@
DROP TABLE task;
DROP TABLE IF EXISTS task;
CREATE TABLE task (
id uuid DEFAULT uuid_generate_v4(),
@ -27,3 +27,11 @@ CREATE TABLE task_default partition OF task default;
CREATE INDEX task__scheduled_at__queue__idx
ON task (scheduled_at, queue)
WHERE status = 'new' or status = 'retry';
ALTER TABLE task
ALTER COLUMN queue SET STORAGE external,
ALTER COLUMN name SET STORAGE external,
ALTER COLUMN props SET STORAGE external,
ALTER COLUMN status SET STORAGE external,
ALTER COLUMN error SET STORAGE external;

6
backend/src/app/migrations/sql/0019-add-improved-scheduled-tasks.sql
View file

@ -1,4 +1,4 @@
DROP TABLE scheduled_task;
DROP TABLE IF EXISTS scheduled_task;
CREATE TABLE scheduled_task (
id text PRIMARY KEY,
@ -22,3 +22,7 @@ CREATE TABLE scheduled_task_history (
CREATE INDEX scheduled_task_history__task_id__idx
ON scheduled_task_history(task_id);
ALTER TABLE scheduled_task
ALTER COLUMN id SET STORAGE external,
ALTER COLUMN cron_expr SET STORAGE external;

11
backend/src/app/migrations/sql/0041-mod-pg-storage-options.sql
View file

@ -27,17 +27,6 @@ ALTER TABLE comment_thread
ALTER COLUMN participants SET STORAGE external,
ALTER COLUMN page_name SET STORAGE external;
ALTER TABLE task
ALTER COLUMN queue SET STORAGE external,
ALTER COLUMN name SET STORAGE external,
ALTER COLUMN props SET STORAGE external,
ALTER COLUMN status SET STORAGE external,
ALTER COLUMN error SET STORAGE external;
ALTER TABLE scheduled_task
ALTER COLUMN id SET STORAGE external,
ALTER COLUMN cron_expr SET STORAGE external;
ALTER TABLE http_session
ALTER COLUMN id SET STORAGE external,
ALTER COLUMN user_agent SET STORAGE external;

43
backend/src/app/migrations/sql/0053-add-team-font-variant-table.sql Normal file
View file

@ -0,0 +1,43 @@
CREATE TABLE team_font_variant (
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
team_id uuid NOT NULL REFERENCES team(id) ON DELETE CASCADE DEFERRABLE,
profile_id uuid NULL REFERENCES profile(id) ON DELETE SET NULL DEFERRABLE,
created_at timestamptz NOT NULL DEFAULT now(),
modified_at timestamptz NOT NULL DEFAULT now(),
deleted_at timestamptz NULL DEFAULT NULL,
font_id uuid NOT NULL,
font_family text NOT NULL,
font_weight smallint NOT NULL,
font_style text NOT NULL,
otf_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
ttf_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
woff1_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
woff2_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE
);
CREATE INDEX team_font_variant_team_id_font_id_idx
ON team_font_variant (team_id, font_id);
CREATE INDEX team_font_variant_profile_id_idx
ON team_font_variant (profile_id);
CREATE INDEX team_font_variant_otf_file_id_idx
ON team_font_variant (otf_file_id);
CREATE INDEX team_font_variant_ttf_file_id_idx
ON team_font_variant (ttf_file_id);
CREATE INDEX team_font_variant_woff1_file_id_idx
ON team_font_variant (woff1_file_id);
CREATE INDEX team_font_variant_woff2_file_id_idx
ON team_font_variant (woff2_file_id);
ALTER TABLE team_font_variant
ALTER COLUMN font_family SET STORAGE external,
ALTER COLUMN font_style SET STORAGE external;

25
backend/src/app/migrations/sql/0054-add-audit-log-table.sql Normal file
View file

@ -0,0 +1,25 @@
CREATE TABLE audit_log (
id uuid NOT NULL DEFAULT uuid_generate_v4(),
name text NOT NULL,
type text NOT NULL,
created_at timestamptz DEFAULT clock_timestamp() NOT NULL,
archived_at timestamptz NULL,
profile_id uuid NOT NULL,
props jsonb,
PRIMARY KEY (created_at, profile_id)
) PARTITION BY RANGE (created_at);
ALTER TABLE audit_log
ALTER COLUMN name SET STORAGE external,
ALTER COLUMN type SET STORAGE external,
ALTER COLUMN props SET STORAGE external;
CREATE INDEX audit_log_id_archived_at_idx ON audit_log (id, archived_at);
CREATE TABLE audit_log_default (LIKE audit_log INCLUDING ALL);
ALTER TABLE audit_log ATTACH PARTITION audit_log_default DEFAULT;

4
backend/src/app/migrations/sql/0055-mod-file-media-object-table.sql Normal file
View file

@ -0,0 +1,4 @@
ALTER TABLE file_media_object
DROP CONSTRAINT file_media_object_thumbnail_id_fkey,
ADD CONSTRAINT file_media_object_thumbnail_id_fkey
FOREIGN KEY (thumbnail_id) REFERENCES storage_object (id) ON DELETE SET NULL;

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

@ -21,6 +21,7 @@
java.time.Duration
io.lettuce.core.RedisClient
io.lettuce.core.RedisURI
io.lettuce.core.api.StatefulConnection
io.lettuce.core.api.StatefulRedisConnection
io.lettuce.core.api.async.RedisAsyncCommands
io.lettuce.core.codec.ByteArrayCodec
@ -130,6 +131,7 @@
;; --- REDIS BACKEND IMPL
(declare impl-redis-open?)
(declare impl-redis-pub)
(declare impl-redis-sub)
(declare impl-redis-unsub)
@ -162,7 +164,8 @@
(a/go-loop []
(when-let [val (a/<! pub-ch)]
(let [result (a/<! (impl-redis-pub rac val))]
(when (ex/exception? result)
(when (and (impl-redis-open? pub-conn)
(ex/exception? result))
(l/error :cause result
:hint "unexpected error on publish message to redis")))
(recur)))))
@ -214,7 +217,8 @@
(let [result (a/<!! (impl-redis-unsub rac topic))]
(l/trace :action "close subscription"
:topic topic)
(when (ex/exception? result)
(when (and (impl-redis-open? sub-conn)
(ex/exception? result))
(l/error :cause result
:hint "unexpected exception on unsubscribing"
:topic topic))))
@ -265,6 +269,10 @@
(run! a/close!)))))))))
(defn- impl-redis-open?
[^StatefulConnection conn]
(.isOpen conn))
(defn- impl-redis-pub
[^RedisAsyncCommands rac {:keys [topic message]}]
(let [message (blob/encode message)

1
backend/src/app/rlimits.clj
View file

@ -18,6 +18,7 @@
(derive ::password ::instance)
(derive ::image ::instance)
(derive ::font ::instance)
(defmethod ig/pre-init-spec ::instance [_]
(s/spec int?))

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

@ -10,6 +10,7 @@
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.loggers.audit :as audit]
[app.metrics :as mtx]
[app.rlimits :as rlm]
[app.util.logging :as l]
@ -84,19 +85,34 @@
(rlm/execute rlinst (f cfg params))))
f))
(defn- wrap-impl
[cfg f mdata]
(let [f (wrap-with-rlimits cfg f mdata)
f (wrap-with-metrics cfg f mdata)
spec (or (::sv/spec mdata) (s/spec any?))]
(l/trace :action "register"
:name (::sv/name mdata))
[{:keys [audit] :as cfg} f mdata]
(let [f (wrap-with-rlimits cfg f mdata)
f (wrap-with-metrics cfg f mdata)
spec (or (::sv/spec mdata) (s/spec any?))
auth? (:auth mdata true)]
(l/trace :action "register" :name (::sv/name mdata))
(fn [params]
(when (and (:auth mdata true) (not (uuid? (:profile-id params))))
(when (and auth? (not (uuid? (:profile-id params))))
(ex/raise :type :authentication
:code :authentication-required
:hint "authentication required for this endpoint"))
(f cfg (us/conform spec params)))))
(let [params (us/conform spec params)
result (f cfg params)
resultm (meta result)]
(when (and (::type cfg) (fn? audit))
(let [profile-id (or (:profile-id params)
(:profile-id result)
(::audit/profile-id resultm))
props (d/merge params (::audit/props resultm))]
(audit :submit {:type (::type cfg)
:name (or (::audit/name resultm)
(::sv/name mdata))
:profile-id profile-id
:props props})))
result))))
(defn- process-method
[cfg vfn]
@ -112,7 +128,7 @@
:registry (get-in cfg [:metrics :registry])
:type :histogram
:help "Timing of query services."})
cfg (assoc cfg ::mobj mobj)]
cfg (assoc cfg ::mobj mobj ::type "query")]
(->> (sv/scan-ns 'app.rpc.queries.projects
'app.rpc.queries.files
'app.rpc.queries.teams
@ -120,6 +136,7 @@
'app.rpc.queries.profile
'app.rpc.queries.recent-files
'app.rpc.queries.viewer
'app.rpc.queries.fonts
'app.rpc.queries.svg)
(map (partial process-method cfg))
(into {}))))
@ -132,7 +149,7 @@
:registry (get-in cfg [:metrics :registry])
:type :histogram
:help "Timing of mutation services."})
cfg (assoc cfg ::mobj mobj)]
cfg (assoc cfg ::mobj mobj ::type "mutation")]
(->> (sv/scan-ns 'app.rpc.mutations.demo
'app.rpc.mutations.media
'app.rpc.mutations.profile
@ -143,6 +160,7 @@
'app.rpc.mutations.teams
'app.rpc.mutations.management
'app.rpc.mutations.ldap
'app.rpc.mutations.fonts
'app.rpc.mutations.verify-token)
(map (partial process-method cfg))
(into {}))))
@ -150,9 +168,11 @@
(s/def ::storage some?)
(s/def ::session map?)
(s/def ::tokens fn?)
(s/def ::audit (s/nilable fn?))
(defmethod ig/pre-init-spec ::rpc [_]
(s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics ::rlm/rlimits]))
(s/keys :req-un [::storage ::session ::tokens ::audit
::mtx/metrics ::rlm/rlimits ::db/pool]))
(defmethod ig/init-key ::rpc
[_ cfg]

6
backend/src/app/rpc/mutations/demo.clj
View file

@ -11,6 +11,7 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.loggers.audit :as audit]
[app.rpc.mutations.profile :as profile]
[app.setup.initial-data :as sid]
[app.util.services :as sv]
@ -53,5 +54,6 @@
::wrk/conn conn
:profile-id id})
{:email email
:password password})))
(with-meta {:email email
:password password}
{::audit/profile-id id}))))

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

@ -228,16 +228,10 @@
{:id file-id}))
;; --- MUTATION: update-file
;; A generic, Changes based (granular) file update method.
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::session-id ::us/uuid)
(s/def ::revn ::us/integer)
(s/def ::update-file
(s/keys :req-un [::id ::session-id ::profile-id ::revn ::changes]))
;; File changes that affect to the library, and must be notified
;; to all clients using it.
(defn library-change?
@ -256,6 +250,31 @@
(declare send-notifications)
(declare update-file)
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::hint-origin ::us/keyword)
(s/def ::hint-events
(s/every ::us/keyword :kind vector?))
(s/def ::change-with-metadata
(s/keys :req-un [::changes]
:opt-un [::hint-origin
::hint-events]))
(s/def ::changes-with-metadata
(s/every ::change-with-metadata :kind vector?))
(s/def ::session-id ::us/uuid)
(s/def ::revn ::us/integer)
(s/def ::update-file
(s/and
(s/keys :req-un [::id ::session-id ::profile-id ::revn]
:opt-un [::changes ::changes-with-metadata])
(fn [o]
(or (contains? o :changes)
(contains? o :changes-with-metadata)))))
(sv/defmethod ::update-file
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
@ -265,7 +284,7 @@
(assoc params :file file)))))
(defn- update-file
[{:keys [conn] :as cfg} {:keys [file changes session-id profile-id] :as params}]
[{:keys [conn] :as cfg} {:keys [file changes changes-with-metadata session-id profile-id] :as params}]
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
@ -274,15 +293,19 @@
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
(let [file (-> file
(update :revn inc)
(update :data (fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(pmg/migrate-data)
(cp/process-changes changes)
(blob/encode)))))]
(let [changes (if changes-with-metadata
(mapcat :changes changes-with-metadata)
changes)
file (-> file
(update :revn inc)
(update :data (fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(pmg/migrate-data)
(cp/process-changes changes)
(blob/encode)))))]
;; Insert change to the xlog
(db/insert! conn :file-change
{:id (uuid/next)
@ -300,7 +323,8 @@
:has-media-trimmed false}
{:id (:id file)})
(let [params (assoc params :file file)]
(let [params (-> params (assoc :file file
:changes changes))]
;; Send asynchronous notifications
(send-notifications cfg params)

143
backend/src/app/rpc/mutations/fonts.clj Normal file
View file

@ -0,0 +1,143 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.rpc.mutations.fonts
(:require
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.media :as media]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
[app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]))
(declare create-font-variant)
(def valid-weight #{100 200 300 400 500 600 700 800 900 950})
(def valid-style #{"normal" "italic"})
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::name ::us/not-empty-string)
(s/def ::weight valid-weight)
(s/def ::style valid-style)
(s/def ::font-id ::us/uuid)
(s/def ::content-type ::media/font-content-type)
(s/def ::data (s/map-of ::us/string any?))
(s/def ::create-font-variant
(s/keys :req-un [::profile-id ::team-id ::data
::font-id ::font-family ::font-weight ::font-style]))
(sv/defmethod ::create-font-variant
[{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg :conn conn)]
(teams/check-edition-permissions! conn profile-id team-id)
(create-font-variant cfg params))))
(defn create-font-variant
[{:keys [conn storage] :as cfg} {:keys [data] :as params}]
(let [data (media/run cfg {:cmd :generate-fonts :input data :rlimit :font})
storage (assoc storage :conn conn)
otf (when-let [fdata (get data "font/otf")]
(sto/put-object storage {:content (sto/content fdata)
:content-type "font/otf"}))
ttf (when-let [fdata (get data "font/ttf")]
(sto/put-object storage {:content (sto/content fdata)
:content-type "font/ttf"}))
woff1 (when-let [fdata (get data "font/woff")]
(sto/put-object storage {:content (sto/content fdata)
:content-type "font/woff"}))
woff2 (when-let [fdata (get data "font/woff2")]
(sto/put-object storage {:content (sto/content fdata)
:content-type "font/woff2"}))]
(db/insert! conn :team-font-variant
{:id (uuid/next)
:team-id (:team-id params)
:font-id (:font-id params)
:font-family (:font-family params)
:font-weight (:font-weight params)
:font-style (:font-style params)
:woff1-file-id (:id woff1)
:woff2-file-id (:id woff2)
:otf-file-id (:id otf)
:ttf-file-id (:id ttf)})))
;; --- UPDATE FONT FAMILY
(s/def ::update-font
(s/keys :req-un [::profile-id ::team-id ::id ::name]))
(def sql:update-font
"update team_font_variant
set font_family = ?
where team_id = ?
and font_id = ?")
(sv/defmethod ::update-font
[{:keys [pool] :as cfg} {:keys [team-id profile-id id name] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(db/exec-one! conn [sql:update-font name team-id id])
nil))
;; --- DELETE FONT
(s/def ::delete-font
(s/keys :req-un [::profile-id ::team-id ::id]))
(sv/defmethod ::delete-font
[{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(let [items (db/query conn :team-font-variant
{:font-id id :team-id team-id}
{:for-update true})]
(doseq [item items]
;; Schedule object deletion
(wrk/submit! {::wrk/task :delete-object
::wrk/delay cf/deletion-delay
::wrk/conn conn
:id (:id item)
:type :team-font-variant}))
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:font-id id :team-id team-id})
nil)))
;; --- DELETE FONT VARIANT
(s/def ::delete-font-variant
(s/keys :req-un [::profile-id ::team-id ::id]))
(sv/defmethod ::delete-font-variant
[{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
;; Schedule object deletion
(wrk/submit! {::wrk/task :delete-object
::wrk/delay cf/deletion-delay
::wrk/conn conn
:id id
:type :team-font-variant})
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id id :team-id team-id})
nil))

12
backend/src/app/rpc/mutations/management.clj
View file

@ -91,21 +91,21 @@
(def sql:retrieve-used-media-objects
"select fmo.*
from file_media_object as fmo
inner join storage_object as o on (fmo.media_id = o.id)
inner join storage_object as so on (fmo.media_id = so.id)
where fmo.file_id = ?
and o.deleted_at is null")
and so.deleted_at is null")
(defn duplicate-file
[conn {:keys [profile-id file index project-id name]} {:keys [reset-shared-flag] :as opts}]
(let [flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)])
fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)])
[conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
(let [flibs (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
fmeds (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
;; memo uniform creation/modification date
now (dt/now)
ignore (dt/plus now (dt/duration {:seconds 5}))
;; add to the index all file media objects.
index (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
index (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
flibs-xf (comp
(map #(remap-id % index :file-id))

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

@ -32,12 +32,15 @@
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
;; --- Create File Media object (upload)
(declare create-file-media-object)
(declare select-file)
(s/def ::content ::media/upload)
(s/def ::content-type ::media/image-content-type)
(s/def ::content (s/and ::media/upload (s/keys :req-un [::content-type])))
(s/def ::is-local ::us/boolean)
(s/def ::upload-file-media-object

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

@ -6,13 +6,14 @@
(ns app.rpc.mutations.profile
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.emails :as eml]
[app.http.oauth :refer [extract-props]]
[app.loggers.audit :as audit]
[app.media :as media]
[app.rpc.mutations.projects :as projects]
[app.rpc.mutations.teams :as teams]
@ -59,9 +60,10 @@
(ex/raise :type :restriction
:code :registration-disabled))
(when-not (email-domain-in-whitelist? (cfg/get :registration-domain-whitelist) (:email params))
(ex/raise :type :validation
:code :email-domain-is-not-allowed))
(when-let [domains (cfg/get :registration-domain-whitelist)]
(when-not (email-domain-in-whitelist? domains (:email params))
(ex/raise :type :validation
:code :email-domain-is-not-allowed)))
(when-not (:terms-privacy params)
(ex/raise :type :validation
@ -101,7 +103,9 @@
resp {:invitation-token token}]
(with-meta resp
{:transform-response ((:create session) (:id profile))
:before-complete (annotate-profile-register metrics profile)}))
:before-complete (annotate-profile-register metrics profile)
::audit/props (:props profile)
::audit/profile-id (:id profile)}))
;; If no token is provided, send a verification email
(let [vtoken (tokens :generate
@ -129,17 +133,20 @@
:extra-data ptoken})
(with-meta profile
{:before-complete (annotate-profile-register metrics profile)})))))
{:before-complete (annotate-profile-register metrics profile)
::audit/props (:props profile)
::audit/profile-id (:id profile)})))))
(defn email-domain-in-whitelist?
"Returns true if email's domain is in the given whitelist or if given
whitelist is an empty string."
[whitelist email]
(if (str/empty-or-nil? whitelist)
"Returns true if email's domain is in the given whitelist or if
given whitelist is an empty string."
[domains email]
(if (or (empty? domains)
(nil? domains))
true
(let [domains (str/split whitelist #",\s*")
domain (second (str/split email #"@" 2))]
(contains? (set domains) domain))))
(let [[_ candidate] (-> (str/lower email)
(str/split #"@" 2))]
(contains? domains candidate))))
(def ^:private sql:profile-existence
"select exists (select * from profile
@ -174,11 +181,12 @@
(defn create-profile
"Create the profile entry on the database with limited input
filling all the other fields with defaults."
[conn {:keys [id fullname email password props is-active is-muted is-demo opts]
:or {is-active false is-muted false is-demo false}}]
[conn {:keys [id fullname email password is-active is-muted is-demo opts]
:or {is-active false is-muted false is-demo false}
:as params}]
(let [id (or id (uuid/next))
is-active (if is-demo true is-active)
props (db/tjson (or props {}))
props (-> params extract-props db/tjson)
password (derive-password password)
params {:id id
:fullname fullname
@ -270,10 +278,12 @@
:member-email (:email profile))
token (tokens :generate claims)]
(with-meta {:invitation-token token}
{:transform-response ((:create session) (:id profile))}))
{:transform-response ((:create session) (:id profile))
::audit/profile-id (:id profile)}))
(with-meta profile
{:transform-response ((:create session) (:id profile))}))))))
{:transform-response ((:create session) (:id profile))
::audit/profile-id (:id profile)}))))))
;; --- Mutation: Logout
@ -298,35 +308,39 @@
[{:keys [pool metrics] :as cfg} params]
(db/with-atomic [conn pool]
(let [profile (-> (assoc cfg :conn conn)
(login-or-register params))]
(login-or-register params))
props (merge
(select-keys profile [:backend :fullname :email])
(:props profile))]
(with-meta profile
{:before-complete (annotate-profile-register metrics profile)}))))
{:before-complete (annotate-profile-register metrics profile)
::audit/name (if (::created profile) "register" "login")
::audit/props props
::audit/profile-id (:id profile)}))))
(defn login-or-register
[{:keys [conn] :as cfg} {:keys [email backend] :as params}]
(letfn [(info->props [info]
(dissoc info :name :fullname :email :backend))
(info->lang [{:keys [locale] :as info}]
[{:keys [conn] :as cfg} {:keys [email] :as params}]
(letfn [(info->lang [{:keys [locale] :as info}]
(when (and (string? locale)
(not (str/blank? locale)))
locale))
(create-profile [conn {:keys [email] :as info}]
(db/insert! conn :profile
{:id (uuid/next)
:fullname (:fullname info)
:email (str/lower email)
:lang (info->lang info)
:auth-backend backend
:is-active true
:password "!"
:props (db/tjson (info->props info))
:is-demo false}))
(create-profile [conn {:keys [fullname backend email props] :as info}]
(let [params {:id (uuid/next)
:fullname fullname
:email (str/lower email)
:lang (info->lang props)
:auth-backend backend
:is-active true
:password "!"
:props (db/tjson props)
:is-demo false}]
(-> (db/insert! conn :profile params)
(update :props db/decode-transit-pgobject))))
(update-profile [conn info profile]
(let [props (d/merge (:props profile)
(info->props info))]
(let [props (merge (:props profile)
(:props info))]
(db/update! conn :profile
{:props (db/tjson props)
:modified-at (dt/now)}
@ -401,7 +415,9 @@
(declare update-profile-photo)
(s/def ::file ::media/upload)
(s/def ::content-type ::media/image-content-type)
(s/def ::file (s/and ::media/upload (s/keys :req-un [::content-type])))
(s/def ::update-profile-photo
(s/keys :req-un [::profile-id ::file]))
@ -605,7 +621,7 @@
;; Schedule a complete deletion of profile
(wrk/submit! {::wrk/task :delete-profile
::wrk/dalay cfg/deletion-delay
::wrk/delay cfg/deletion-delay
::wrk/conn conn
:profile-id profile-id})

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

@ -249,7 +249,9 @@
(declare upload-photo)
(s/def ::file ::media/upload)
(s/def ::content-type ::media/image-content-type)
(s/def ::file (s/and ::media/upload (s/keys :req-un [::content-type])))
(s/def ::update-team-photo
(s/keys :req-un [::profile-id ::team-id ::file]))

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

@ -6,12 +6,13 @@
(ns app.rpc.queries.files
(:require
[app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc.permissions :as perms]
[app.rpc.queries.projects :as projects]
[app.rpc.queries.teams :as teams]
[app.util.blob :as blob]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
@ -97,7 +98,13 @@
ppr.is_owner = true or
ppr.can_edit = true)
)
select distinct f.*
select distinct
f.id,
f.project_id,
f.created_at,
f.modified_at,
f.name,
f.is_shared
from file as f
inner join projects as pr on (f.project_id = pr.id)
where f.name ilike ('%' || ? || '%')
@ -109,14 +116,15 @@
(sv/defmethod ::search-files
[{:keys [pool] :as cfg} {:keys [profile-id team-id search-term] :as params}]
(let [rows (db/exec! pool [sql:search-files
profile-id team-id
profile-id team-id
search-term])]
(into [] decode-row-xf rows)))
(db/exec! pool [sql:search-files
profile-id team-id
profile-id team-id
search-term]))
;; --- Query: Project Files
;; --- Query: Files
;; DEPRECATED: should be removed probably on 1.6.x
(def ^:private sql:files
"select f.*
@ -136,6 +144,29 @@
(into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
;; --- Query: Project Files
(def ^:private sql:project-files
"select f.id,
f.project_id,
f.created_at,
f.modified_at,
f.name,
f.is_shared
from file as f
where f.project_id = ?
and f.deleted_at is null
order by f.modified_at desc")
(s/def ::project-files
(s/keys :req-un [::profile-id ::project-id]))
(sv/defmethod ::project-files
[{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
(with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id)
(db/exec! conn [sql:project-files project-id])))
;; --- Query: File (By ID)
(defn retrieve-file
@ -154,17 +185,50 @@
(retrieve-file conn id)))
(s/def ::page
(s/keys :req-un [::profile-id ::id ::file-id]))
(s/keys :req-un [::profile-id ::file-id]))
(defn remove-thumbnails-frames
"Removes from data the children for frames that have a thumbnail set up"
[data]
(let [filter-shape?
(fn [objects [id shape]]
(let [frame-id (:frame-id shape)]
(or (= id uuid/zero)
(= frame-id uuid/zero)
(not (some? (get-in objects [frame-id :thumbnail]))))))
;; We need to remove from the attribute :shapes its childrens because
;; they will not be sent in the data
remove-frame-children
(fn [[id shape]]
[id (cond-> shape
(some? (:thumbnail shape))
(assoc :shapes []))])
update-objects
(fn [objects]
(into {}
(comp (map remove-frame-children)
(filter (partial filter-shape? objects)))
objects))]
(update data :objects update-objects)))
(sv/defmethod ::page
[{:keys [pool] :as cfg} {:keys [profile-id file-id id]}]
[{:keys [pool] :as cfg} {:keys [profile-id file-id id strip-thumbnails]}]
[{:keys [pool] :as cfg} {:keys [profile-id file-id]}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)
(let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id]))))
(let [file (retrieve-file conn file-id)
page-id (get-in file [:data :pages 0])]
(cond-> (get-in file [:data :pages-index page-id])
strip-thumbnails
(remove-thumbnails-frames)))))
;; --- Query: Shared Library Files
;; DEPRECATED: and will be removed on 1.6.x
(def ^:private sql:shared-files
"select f.*
from file as f
@ -183,11 +247,36 @@
(into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
;; --- Query: Shared Library Files
(def ^:private sql:team-shared-files
"select f.id,
f.project_id,
f.created_at,
f.modified_at,
f.name,
f.is_shared
from file as f
inner join project as p on (p.id = f.project_id)
where f.is_shared = true
and f.deleted_at is null
and p.deleted_at is null
and p.team_id = ?
order by f.modified_at desc")
(s/def ::team-shared-files
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::team-shared-files
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(db/exec! pool [sql:team-shared-files team-id]))
;; --- Query: File Libraries used by a File
(def ^:private sql:file-libraries
"select fl.*,
? as is_indirect,
flr.synced_at as synced_at
from file as fl
inner join file_library_rel as flr on (flr.library_file_id = fl.id)
@ -196,22 +285,13 @@
(defn retrieve-file-libraries
[conn is-indirect file-id]
(let [direct-libraries
(into [] decode-row-xf (db/exec! conn [sql:file-libraries is-indirect file-id]))
(let [libraries (->> (db/exec! conn [sql:file-libraries file-id])
(map #(assoc % :is-indirect is-indirect))
(into #{} decode-row-xf))]
(reduce #(into %1 (retrieve-file-libraries conn true %2))
libraries
(map :id libraries))))
select-distinct
(fn [used-libraries new-libraries]
(remove (fn [new-library]
(some #(= (:id %) (:id new-library)) used-libraries))
new-libraries))]
(reduce (fn [used-libraries library]
(concat used-libraries
(select-distinct
used-libraries
(retrieve-file-libraries conn true (:id library)))))
direct-libraries
direct-libraries)))
(s/def ::file-libraries
(s/keys :req-un [::profile-id ::file-id]))
@ -222,31 +302,35 @@
(check-edition-permissions! conn profile-id file-id)
(retrieve-file-libraries conn false file-id)))
;; --- QUERY: team-recent-files
;; --- Query: Single File Library
(def sql:team-recent-files
"with recent_files as (
select f.id,
f.project_id,
f.created_at,
f.modified_at,
f.name,
f.is_shared,
row_number() over w as row_num
from file as f
join project as p on (p.id = f.project_id)
where p.team_id = ?
and p.deleted_at is null
and f.deleted_at is null
window w as (partition by f.project_id order by f.modified_at desc)
order by f.modified_at desc
)
select * from recent_files where row_num <= 10;")
;; TODO: this looks like is duplicate of `::file`
(s/def ::team-recent-files
(s/keys :req-un [::profile-id ::team-id]))
(def ^:private sql:file-library
"select fl.*
from file as fl
where fl.id = ?")
(defn retrieve-file-library
[conn file-id]
(let [rows (db/exec! conn [sql:file-library file-id])]
(when-not (seq rows)
(ex/raise :type :not-found))
(first (sequence decode-row-xf rows))))
(s/def ::file-library
(s/keys :req-un [::profile-id ::file-id]))
(sv/defmethod ::file-library
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions
(retrieve-file-library conn file-id)))
(sv/defmethod ::team-recent-files
[{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(db/exec! conn [sql:team-recent-files team-id])))
;; --- Helpers

29
backend/src/app/rpc/queries/fonts.clj Normal file
View file

@ -0,0 +1,29 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.rpc.queries.fonts
(:require
[app.common.spec :as us]
[app.db :as db]
[app.rpc.queries.teams :as teams]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Query: Team Font Variants
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::team-font-variants
(s/keys :req-un [::profile-id ::team-id]))
(sv/defmethod ::team-font-variants
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(db/query conn :team-font-variant
{:team-id team-id
:deleted-at nil})))

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

@ -13,6 +13,8 @@
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; DEPRECATED: should be removed on 1.6.x
(def sql:recent-files
"with recent_files as (
select f.*, row_number() over w as row_num

28
backend/src/app/setup.clj
View file

@ -29,16 +29,26 @@
(initialize-instance-id! cfg)
(retrieve-all cfg))))
(def sql:upsert-secret-key
"insert into server_prop (id, preload, content)
values ('secret-key', true, ?::jsonb)
on conflict (id) do update set content = ?::jsonb")
(def sql:insert-secret-key
"insert into server_prop (id, preload, content)
values ('secret-key', true, ?::jsonb)
on conflict (id) do nothing")
(defn- initialize-secret-key!
[{:keys [conn] :as cfg}]
(let [key (-> (bn/random-bytes 64)
(bc/bytes->b64u)
(bc/bytes->str))]
(db/insert! conn :server-prop
{:id "secret-key"
:preload true
:content (db/tjson key)}
{:on-conflict-do-nothing true})))
[{:keys [conn key] :as cfg}]
(if key
(let [key (db/tjson key)]
(db/exec-one! conn [sql:upsert-secret-key key key]))
(let [key (-> (bn/random-bytes 64)
(bc/bytes->b64u)
(bc/bytes->str))
key (db/tjson key)]
(db/exec-one! conn [sql:insert-secret-key key]))))
(defn- initialize-instance-id!
[{:keys [conn] :as cfg}]

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

@ -8,7 +8,7 @@
(:refer-clojure :exclude [load])
(:require
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.config :as cf]
[app.db :as db]
[app.rpc.mutations.management :refer [duplicate-file]]
[app.rpc.mutations.projects :refer [create-project create-project-role]]
@ -36,7 +36,7 @@
([system project-id {:keys [skey project-name]
:or {project-name "Penpot Onboarding"}}]
(db/with-atomic [conn (:app.db/pool system)]
(let [skey (or skey (cfg/get :initial-project-skey))
(let [skey (or skey (cf/get :initial-project-skey))
files (db/exec! conn [sql:file project-id])
flibs (db/exec! conn [sql:file-library-rel project-id])
fmeds (db/exec! conn [sql:file-media-object project-id])
@ -65,7 +65,7 @@
(defn load-initial-project!
([conn profile] (load-initial-project! conn profile nil))
([conn profile opts]
(let [skey (or (:skey opts) (cfg/get :initial-project-skey))
(let [skey (or (:skey opts) (cf/get :initial-project-skey))
data (retrieve-data conn skey)]
(when data
(let [index (reduce #(assoc %1 (:id %2) (uuid/next)) {} (:files data))
@ -82,10 +82,16 @@
:role :owner})
(doseq [file (:files data)]
(let [params {:profile-id (:id profile)
(let [flibs (filterv #(= (:id file) (:file-id %)) (:flibs data))
fmeds (filterv #(= (:id file) (:file-id %)) (:fmeds data))
params {:profile-id (:id profile)
:project-id (:id project)
:file file
:index index}
:index index
:flibs flibs
:fmeds fmeds}
opts {:reset-shared-flag false}]
(duplicate-file conn params opts))))))))

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

@ -145,8 +145,8 @@
(make-output-stream [_ opts]
(throw (UnsupportedOperationException. "not implemented")))
clojure.lang.Counted
(count [_] size)))
clojure.lang.Counted
(count [_] size)))
(defn content
([data] (content data nil))

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

@ -10,6 +10,7 @@
[app.common.data :as d]
[app.common.spec :as us]
[app.db :as db]
[app.storage :as sto]
[app.util.logging :as l]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
@ -24,7 +25,8 @@
(fn [{:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn pool]
(handle-deletion conn props))))
(let [cfg (assoc cfg :conn conn)]
(handle-deletion cfg props)))))
(s/def ::type ::us/keyword)
(s/def ::id ::us/uuid)
@ -34,21 +36,32 @@
(fn [_ props] (:type props)))
(defmethod handle-deletion :default
[_conn {:keys [type]}]
[_cfg {:keys [type]}]
(l/warn :hint "no handler found"
:type (d/name type)))
(defmethod handle-deletion :file
[conn {:keys [id] :as props}]
[{:keys [conn]} {:keys [id] :as props}]
(let [sql "delete from file where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))
(defmethod handle-deletion :project
[conn {:keys [id] :as props}]
[{:keys [conn]} {:keys [id] :as props}]
(let [sql "delete from project where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))
(defmethod handle-deletion :team
[conn {:keys [id] :as props}]
[{:keys [conn]} {:keys [id] :as props}]
(let [sql "delete from team where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))
(defmethod handle-deletion :team-font-variant
[{:keys [conn storage]} {:keys [id] :as props}]
(let [font (db/get-by-id conn :team-font-variant id {:uncheked true})
storage (assoc storage :conn conn)]
(when (:deleted-at font)
(db/delete! conn :team-font-variant {:id id})
(some->> (:woff1-file-id font) (sto/del-object storage))
(some->> (:woff2-file-id font) (sto/del-object storage))
(some->> (:otf-file-id font) (sto/del-object storage))
(some->> (:ttf-file-id font) (sto/del-object storage)))))

5
backend/src/app/tasks/file_media_gc.clj
View file

@ -101,7 +101,10 @@
:media-id (:media-id mobj)
:thumbnail-id (:thumbnail-id mobj))
;; NOTE: deleting the file-media-object in the database
;; automatically marks as toched the referenced storage objects.
;; automatically marks as toched the referenced storage
;; objects. The touch mechanism is needed because many files can
;; point to the same storage objects and we can't just delete
;; them.
(db/delete! conn :file-media-object {:id (:id mobj)}))
nil))

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

@ -60,10 +60,9 @@
:uri (:uri cfg)
:headers {"content-type" "application/json"}
:body (json/encode-str data)})]
(when (not= 200 (:status response))
(when (> (:status response) 206)
(ex/raise :type :internal
:code :invalid-response-from-google
:code :invalid-response
:context {:status (:status response)
:body (:body response)}))))

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

@ -51,11 +51,11 @@
claims))
(s/def ::secret-key ::us/string)
(s/def ::sprops
(s/def ::props
(s/keys :req-un [::secret-key]))
(defmethod ig/pre-init-spec ::tokens [_]
(s/keys :req-un [::sprops]))
(s/keys :req-un [::props]))
(defn- generate-predefined
[cfg {:keys [iss profile-id] :as params}]
@ -71,8 +71,8 @@
:hint "no predefined token")))
(defmethod ig/init-key ::tokens
[_ {:keys [sprops] :as cfg}]
(let [secret (derive-tokens-secret (:secret-key sprops))
[_ {:keys [props] :as cfg}]
(let [secret (derive-tokens-secret (:secret-key props))
cfg (assoc cfg ::secret secret)]
(fn [action params]
(case action

39
backend/src/app/util/async.clj
View file

@ -60,3 +60,42 @@
(if (= executor ::default)
`(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
`(thread-call ~executor (^:once fn* [] ~@body))))
(defn batch
[in {:keys [max-batch-size
max-batch-age
init]
:or {max-batch-size 200
max-batch-age (* 30 1000)
init #{}}
:as opts}]
(let [out (a/chan)]
(a/go-loop [tch (a/timeout max-batch-age) buf init]
(let [[val port] (a/alts! [tch in])]
(cond
(identical? port tch)
(if (empty? buf)
(recur (a/timeout max-batch-age) buf)
(do
(a/>! out [:timeout buf])
(recur (a/timeout max-batch-age) init)))
(nil? val)
(if (empty? buf)
(a/close! out)
(do
(a/offer! out [:timeout buf])
(a/close! out)))
(identical? port in)
(let [buf (conj buf val)]
(if (>= (count buf) max-batch-size)
(do
(a/>! out [:size buf])
(recur (a/timeout max-batch-age) init))
(recur tch buf))))))
out))
(defn thread-sleep
[ms]
(Thread/sleep ms))

12
backend/src/app/util/logging.clj
View file

@ -60,8 +60,8 @@
^Object msg)))
(defmacro log
[& {:keys [level cause ::logger ::async] :as props}]
(let [props (dissoc props :level :cause ::logger ::async)
[& {:keys [level cause ::logger ::async ::raw] :as props}]
(let [props (dissoc props :level :cause ::logger ::async ::raw)
logger (or logger (str *ns*))
logger-sym (gensym "log")
level-sym (gensym "log")]
@ -69,8 +69,12 @@
~level-sym (get-level ~level)]
(if (enabled? ~logger-sym ~level-sym)
~(if async
`(send-off logging-agent (fn [_#] (write-log! ~logger-sym ~level-sym ~cause (build-map-message ~props))))
`(write-log! ~logger-sym ~level-sym ~cause (build-map-message ~props)))))))
`(send-off logging-agent
(fn [_#]
(let [message# (or ~raw (build-map-message ~props))]
(write-log! ~logger-sym ~level-sym ~cause message#))))
`(let [message# (or ~raw (build-map-message ~props))]
(write-log! ~logger-sym ~level-sym ~cause message#)))))))
(defmacro info
[& params]

BIN
backend/tests/app/tests/_files/font-1.otf Normal file
View file

Binary file not shown.

BIN
backend/tests/app/tests/_files/font-1.ttf Normal file
View file

Binary file not shown.

BIN
backend/tests/app/tests/_files/font-1.woff Normal file
View file

Binary file not shown.

BIN
backend/tests/app/tests/_files/font-2.otf Normal file
View file

Binary file not shown.

BIN
backend/tests/app/tests/_files/font-2.woff Normal file
View file

Binary file not shown.

18
backend/tests/app/tests/test_common_geom_shapes.clj
View file

@ -52,7 +52,7 @@
(t/testing "Shape without modifiers should stay the same"
(t/are [type]
(let [shape-before (create-test-shape type)
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(= shape-before shape-after))
:rect :path))
@ -61,7 +61,7 @@
(t/are [type]
(let [modifiers {:displacement (gmt/translate-matrix (gpt/point 10 -10))}]
(let [shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/is (not= shape-before shape-after))
(t/is (close? (get-in shape-before [:selrect :x])
@ -82,7 +82,7 @@
(t/are [type]
(let [modifiers {:displacement (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/are [prop]
(t/is (close? (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
@ -95,7 +95,7 @@
:resize-vector (gpt/point 2 2)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/is (not= shape-before shape-after))
(t/is (close? (get-in shape-before [:selrect :x])
@ -117,7 +117,7 @@
:resize-vector (gpt/point 1 1)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/are [prop]
(t/is (close? (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
@ -130,7 +130,7 @@
:resize-vector (gpt/point 0 0)
:resize-transform (gmt/matrix)}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/is (> (get-in shape-before [:selrect :width])
(get-in shape-after [:selrect :width])))
(t/is (> (get-in shape-after [:selrect :width]) 0))
@ -144,7 +144,7 @@
(t/are [type]
(let [modifiers {:rotation 30}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/is (not= shape-before shape-after))
@ -168,7 +168,7 @@
(t/are [type]
(let [modifiers {:rotation 0}
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(t/are [prop]
(t/is (close? (get-in shape-before [:selrect prop])
(get-in shape-after [:selrect prop])))
@ -180,7 +180,7 @@
(let [modifiers {:displacement (gmt/matrix)}
shape-before (-> (create-test-shape type {:modifiers modifiers})
(assoc :selrect selrect))
shape-after (gsh/transform-shape shape-before)]
shape-after (gsh/transform-shape shape-before {:round-coords? false})]
(= (:selrect shape-before) (:selrect shape-after)))
:rect {:x 0 :y 0 :width ##Inf :height ##Inf}

94
backend/tests/app/tests/test_common_pages_migrations.clj Normal file
View file

@ -0,0 +1,94 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.tests.test-common-pages-migrations
(:require
[clojure.test :as t]
[clojure.pprint :refer [pprint]]
[promesa.core :as p]
[mockery.core :refer [with-mock]]
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.pages.migrations :as cpm]
[app.common.uuid :as uuid]
[app.tests.helpers :as th]))
(t/deftest test-migration-8-1
(let [page-id (uuid/custom 0 0)
objects [{:type :rect :id (uuid/custom 1 0)}
{:type :group
:id (uuid/custom 1 1)
:selrect {}
:shapes [(uuid/custom 1 2) (uuid/custom 1 0)]}
{:type :group
:id (uuid/custom 1 2)
:selrect {}
:shapes [(uuid/custom 1 3)]}
{:type :group
:id (uuid/custom 1 3)
:selrect {}
:shapes [(uuid/custom 1 4)]}
{:type :group
:id (uuid/custom 1 4)
:selrect {}
:shapes [(uuid/custom 1 5)]}
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}
:version 7}
res (cpm/migrate-data data)]
(pprint data)
(pprint res)
(t/is (= (dissoc data :version)
(dissoc res :version)))))
(t/deftest test-migration-8-2
(let [page-id (uuid/custom 0 0)
objects [{:type :rect :id (uuid/custom 1 0)}
{:type :group
:id (uuid/custom 1 1)
:selrect {}
:shapes [(uuid/custom 1 2) (uuid/custom 1 0)]}
{:type :group
:id (uuid/custom 1 2)
:selrect {}
:shapes [(uuid/custom 1 3)]}
{:type :group
:id (uuid/custom 1 3)
:selrect {}
:shapes [(uuid/custom 1 4)]}
{:type :group
:id (uuid/custom 1 4)
:selrect {}
:shapes []}
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}
:version 7}
expct (-> data
(update-in [:pages-index page-id :objects] dissoc
(uuid/custom 1 2)
(uuid/custom 1 3)
(uuid/custom 1 4))
(update-in [:pages-index page-id :objects (uuid/custom 1 1) :shapes]
(fn [shapes]
(let [id (uuid/custom 1 2)]
(into [] (remove #(= id %)) shapes)))))
res (cpm/migrate-data data)]
(pprint res)
(pprint expct)
(t/is (= (dissoc expct :version)
(dissoc res :version)))
))

16
backend/tests/app/tests/test_services_files.clj
View file

@ -52,7 +52,7 @@
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result))))))
(t/testing "query files"
(t/testing "query files (deprecated)"
(let [data {::th/type :files
:project-id proj-id
:profile-id (:id prof)}
@ -67,6 +67,20 @@
(t/is (= "new name" (get-in result [0 :name])))
(t/is (= 1 (count (get-in result [0 :data :pages])))))))
(t/testing "query files"
(let [data {::th/type :project-files
:project-id proj-id
:profile-id (:id prof)}
out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 1 (count result)))
(t/is (= file-id (get-in result [0 :id])))
(t/is (= "new name" (get-in result [0 :name]))))))
(t/testing "query single file without users"
(let [data {::th/type :file
:profile-id (:id prof)

94
backend/tests/app/tests/test_services_fonts.clj Normal file
View file

@ -0,0 +1,94 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.tests.test-services-fonts
(:require
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
[app.storage :as sto]
[app.tests.helpers :as th]
[clojure.java.io :as io]
[clojure.test :as t]
[datoteka.core :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest ttf-font-upload-1
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
ttfdata (-> (io/resource "app/tests/_files/font-1.ttf")
(fs/slurp-bytes))
params {::th/type :create-font-variant
:profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/ttf" ttfdata}}
out (th/mutation! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (uuid? (:ttf-file-id result)))
(t/is (uuid? (:otf-file-id result)))
(t/is (uuid? (:woff1-file-id result)))
(t/is (uuid? (:woff2-file-id result)))
(t/are [k] (= (get params k)
(get result k))
:team-id
:font-id
:font-family
:font-weight
:font-style))))
(t/deftest ttf-font-upload-2
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
data (-> (io/resource "app/tests/_files/font-1.woff")
(fs/slurp-bytes))
params {::th/type :create-font-variant
:profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/woff" data}}
out (th/mutation! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (uuid? (:ttf-file-id result)))
(t/is (uuid? (:otf-file-id result)))
(t/is (uuid? (:woff1-file-id result)))
(t/is (uuid? (:woff2-file-id result)))
(t/are [k] (= (get params k)
(get result k))
:team-id
:font-id
:font-family
:font-weight
:font-style))))

4
backend/tests/app/tests/test_services_profile.clj
View file

@ -179,10 +179,10 @@
))
(t/deftest registration-domain-whitelist
(let [whitelist "gmail.com, hey.com, ya.ru"]
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
(t/testing "allowed email domain"
(t/is (true? (profile/email-domain-in-whitelist? whitelist "username@ya.ru")))
(t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
(t/is (true? (profile/email-domain-in-whitelist? #{} "username@somedomain.com"))))
(t/testing "not allowed email domain"
(t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))

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

@ -12,6 +12,7 @@
(:require
[linked.set :as lks]
[app.common.math :as mth]
[clojure.set :as set]
#?(:clj [cljs.analyzer.api :as aapi])
#?(:cljs [cljs.reader :as r]
:clj [clojure.edn :as r])
@ -252,15 +253,22 @@
(map (fn [x] (f x) x) coll)))
(defn merge
"A faster merge."
[& maps]
(loop [res (transient (or (first maps) {}))
maps (next maps)]
(if (nil? maps)
(persistent! res)
(recur (reduce-kv assoc! res (first maps))
(next maps)))))
(reduce conj (or (first maps) {}) (rest maps)))
(defn distinct-xf
[f]
(fn [rf]
(let [seen (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [input* (f input)]
(if (contains? @seen input*)
result
(do (vswap! seen conj input*)
(rf result input)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion
@ -448,3 +456,50 @@
kw (if (keyword? kw) (name kw) kw)]
(keyword (str prefix kw))))
(defn tap
"Simpilar to the tap in rxjs but for plain collections"
[f coll]
(f coll)
coll)
(defn map-diff
"Given two maps returns the diff of its attributes in a map where
the keys will be the attributes that change and the values the previous
and current value. For attributes which value is a map this will be recursive.
For example:
(map-diff {:a 1 :b 2 :c { :foo 1 :var 2}
{:a 2 :c { :foo 10 } :d 10)
=> { :a [1 2]
:b [2 nil]
:c { :foo [1 10]
:var [2 nil]}
:d [nil 10] }
If both maps are identical the result will be an empty map
"
[m1 m2]
(let [m1ks (keys m1)
m2ks (keys m2)
keys (set/union m1ks m2ks)
diff-attr
(fn [diff key]
(let [v1 (get m1 key)
v2 (get m2 key)]
(cond
(= v1 v2)
diff
(and (map? v1) (map? v2))
(assoc diff key (map-diff v1 v2))
:else
(assoc diff key [(get m1 key) (get m2 key)]))))]
(->> keys
(reduce diff-attr {}))))

2
common/app/common/exceptions.cljc
View file

@ -36,7 +36,7 @@
(defn try*
[f on-error]
(try (f) (catch #?(:clj Exception :cljs :default) e (on-error e))))
(try (f) (catch #?(:clj Throwable :cljs :default) e (on-error e))))
;; http://clj-me.cgrand.net/2013/09/11/macros-closures-and-unexpected-object-retention/
;; Explains the use of ^:once metadata

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

@ -162,7 +162,7 @@
:points points))))
(defn rotation-modifiers
[center shape angle]
[shape center angle]
(let [displacement (let [shape-center (gco/center-shape shape)]
(-> (gmt/matrix)
(gmt/rotate angle center)

12
common/app/common/geom/shapes/intersect.cljc
View file

@ -174,9 +174,17 @@
"Checks if the given rect overlaps with the path in any point"
[shape rect]
(let [rect-points (gpr/rect->points rect)
(let [;; If paths are too complex the intersection is too expensive
;; we fallback to check its bounding box otherwise the performance penalty
;; is too big
;; TODO: Look for ways to optimize this operation
simple? (> (count (:content shape)) 100)
rect-points (gpr/rect->points rect)
rect-lines (points->lines rect-points)
path-lines (gpp/path->lines shape)
path-lines (if simple?
(points->lines (:points shape))
(gpp/path->lines shape))
start-point (-> shape :content (first) :params (gpt/point))]
(or (is-point-inside-nonzero? (first rect-points) path-lines)

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

@ -6,13 +6,15 @@
(ns app.common.geom.shapes.transforms
(:require
[app.common.attrs :as attrs]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.path :as gpa]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]
[app.common.data :as d]))
[app.common.data :as d]
[app.common.text :as txt]))
;; --- Relative Movement
@ -264,7 +266,7 @@
(defn apply-transform
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform]
[shape transform round-coords?]
;;
(let [points (-> shape :points (transform-points transform))
center (gco/center-points points)
@ -288,6 +290,13 @@
[matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
rect-shape (cond-> rect-shape
round-coords?
(-> (update :x mth/round)
(update :y mth/round)
(update :width mth/round)
(update :height mth/round)))
shape (cond
(= :path (:type shape))
(-> shape
@ -295,11 +304,7 @@
:else
(-> shape
(merge rect-shape)
(update :x #(mth/precision % 0))
(update :y #(mth/precision % 0))
(update :width #(mth/precision % 0))
(update :height #(mth/precision % 0))))]
(merge rect-shape)))]
(as-> shape $
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
(update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
@ -328,17 +333,40 @@
(dissoc :modifiers))))
shape)))
(defn transform-shape [shape]
(let [shape (apply-displacement shape)
center (gco/center-shape shape)
modifiers (:modifiers shape)]
(if (and modifiers center)
(let [transform (modifiers->transform center modifiers)]
(-> shape
(set-flip modifiers)
(apply-transform transform)
(dissoc :modifiers)))
shape)))
(defn apply-text-resize
[shape orig-shape modifiers]
(if (and (= (:type shape) :text)
(:resize-scale-text modifiers))
(let [merge-attrs (fn [attrs]
(let [font-size (-> (get attrs :font-size 14)
(d/parse-double)
(* (-> modifiers :resize-vector :x))
(str)
)]
(attrs/merge attrs {:font-size font-size})))]
(update shape :content #(txt/transform-nodes
txt/is-text-node?
merge-attrs
%)))
shape))
(defn transform-shape
([shape]
(transform-shape shape nil))
([shape {:keys [round-coords?]
:or {round-coords? true}}]
(let [shape (apply-displacement shape)
center (gco/center-shape shape)
modifiers (:modifiers shape)]
(if (and modifiers center)
(let [transform (modifiers->transform center modifiers)]
(-> shape
(set-flip modifiers)
(apply-transform transform round-coords?)
(apply-text-resize shape modifiers)
(dissoc :modifiers)))
shape))))
(defn update-group-viewbox
"Updates the viewbox for groups imported from SVG's"
@ -387,5 +415,5 @@
;; need to remove the flip flags
(assoc :flip-x false)
(assoc :flip-y false)
(apply-transform (gmt/matrix)))))
(apply-transform (gmt/matrix) true))))

43
common/app/common/media.cljc
View file

@ -9,10 +9,10 @@
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(def valid-media-types
#{"image/jpeg", "image/png", "image/webp", "image/gif", "image/svg+xml"})
(def str-media-types (str/join "," valid-media-types))
(def valid-font-types #{"font/ttf" "font/woff", "font/otf"})
(def valid-image-types #{"image/jpeg", "image/png", "image/webp", "image/gif", "image/svg+xml"})
(def str-image-types (str/join "," valid-image-types))
(def str-font-types (str/join "," valid-font-types))
(defn format->extension
[format]
@ -65,3 +65,38 @@
::modified-at
::uri]))
(defn parse-font-weight
[variant]
(cond
(re-seq #"(?i)(?:hairline|thin)" variant) 100
(re-seq #"(?i)(?:extra\s*light|ultra\s*light)" variant) 200
(re-seq #"(?i)(?:light)" variant) 300
(re-seq #"(?i)(?:normal|regular)" variant) 400
(re-seq #"(?i)(?:medium)" variant) 500
(re-seq #"(?i)(?:semi\s*bold|demi\s*bold)" variant) 600
(re-seq #"(?i)(?:extra\s*bold|ultra\s*bold)" variant) 800
(re-seq #"(?i)(?:bold)" variant) 700
(re-seq #"(?i)(?:extra\s*black|ultra\s*black)" variant) 950
(re-seq #"(?i)(?:black|heavy)" variant) 900
:else 400))
(defn parse-font-style
[variant]
(if (re-seq #"(?i)(?:italic)" variant)
"italic"
"normal"))
(defn font-weight->name
[weight]
(case weight
100 "Hairline"
200 "Extra Light"
300 "Light"
400 "Regular"
500 "Medium"
600 "Semi Bold"
700 "Bold"
800 "Extra Bold"
900 "Black"
950 "Extra Black"))

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

@ -11,6 +11,7 @@
[app.common.pages.changes :as changes]
[app.common.pages.common :as common]
[app.common.pages.helpers :as helpers]
[app.common.pages.indices :as indices]
[app.common.pages.init :as init]
[app.common.pages.spec :as spec]
[clojure.spec.alpha :as s]))
@ -42,7 +43,6 @@
(d/export helpers/is-shape-grouped)
(d/export helpers/get-parent)
(d/export helpers/get-parents)
(d/export helpers/generate-child-parent-index)
(d/export helpers/clean-loops)
(d/export helpers/calculate-invalid-targets)
(d/export helpers/valid-frame-target)
@ -60,12 +60,18 @@
(d/export helpers/get-base-shape)
(d/export helpers/is-parent?)
(d/export helpers/get-index-in-parent)
(d/export helpers/calculate-z-index)
(d/export helpers/generate-child-all-parents-index)
(d/export helpers/parse-path-name)
(d/export helpers/merge-path-item)
(d/export helpers/compact-path)
(d/export helpers/compact-name)
(d/export helpers/merge-modifiers)
;; Indices
(d/export indices/calculate-z-index)
(d/export indices/update-z-index)
(d/export indices/generate-child-all-parents-index)
(d/export indices/generate-child-parent-index)
(d/export indices/create-mask-index)
;; Process changes
(d/export changes/process-changes)

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

@ -8,7 +8,7 @@
(:require
[app.common.uuid :as uuid]))
(def file-version 6)
(def file-version 8)
(def default-color "#b1b2b5") ;; $color-gray-20
(def root uuid/zero)

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

@ -10,6 +10,7 @@
[app.common.geom.shapes :as gsh]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[clojure.set :as set]
[cuerdas.core :as str]))
(defn walk-pages
@ -160,27 +161,6 @@
(when parent-id
(lazy-seq (cons parent-id (get-parents parent-id objects))))))
(defn generate-child-parent-index
[objects]
(reduce-kv
(fn [index id obj]
(assoc index id (:parent-id obj)))
{} objects))
(defn generate-child-all-parents-index
"Creates an index where the key is the shape id and the value is a set
with all the parents"
([objects]
(generate-child-all-parents-index objects (vals objects)))
([objects shapes]
(let [shape->parents
(fn [shape]
(->> (get-parents (:id shape) objects)
(into [])))]
(->> shapes
(map #(vector (:id %) (shape->parents %)))
(into {})))))
(defn clean-loops
"Clean a list of ids from circular references."
@ -347,40 +327,7 @@
(reduce red-fn cur-idx (reverse (:shapes object)))))]
(into {} (rec-index '() uuid/zero))))
(defn calculate-z-index
"Given a collection of shapes calculates their z-index. Greater index
means is displayed over other shapes with less index."
[objects]
(let [is-frame? (fn [id] (= :frame (get-in objects [id :type])))
root-children (get-in objects [uuid/zero :shapes])
num-frames (->> root-children (filter is-frame?) count)]
(when (seq root-children)
(loop [current (peek root-children)
pending (pop root-children)
current-idx (+ (count objects) num-frames -1)
z-index {}]
(let [children (->> (get-in objects [current :shapes]))
children (cond
(and (is-frame? current) (contains? z-index current))
[]
(and (is-frame? current)
(not (contains? z-index current)))
(into [current] children)
:else
children)
pending (into (vec pending) children)]
(if (empty? pending)
(assoc z-index current current-idx)
(let []
(recur (peek pending)
(pop pending)
(dec current-idx)
(assoc z-index current current-idx)))))))))
(defn expand-region-selection
"Given a selection selects all the shapes between the first and last in
@ -511,3 +458,12 @@
(let [path-split (split-path path)]
(merge-path-item (first path-split) name)))
(defn merge-modifiers
[objects modifiers]
(let [set-modifier
(fn [objects [id modifiers]]
(-> objects
(d/update-when id merge modifiers)))]
(->> modifiers
(reduce set-modifier objects))))

110
common/app/common/pages/indices.cljc Normal file
View file

@ -0,0 +1,110 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.common.pages.indices
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as helpers]
[app.common.uuid :as uuid]
[clojure.set :as set]))
(defn calculate-frame-z-index [z-index frame-id objects]
(let [is-frame? (fn [id] (= :frame (get-in objects [id :type])))
frame-shapes (->> objects (vals) (filterv #(= (:frame-id %) frame-id)))
children (or (get-in objects [frame-id :shapes]) [])]
(if (empty? children)
z-index
(loop [current (peek children)
pending (pop children)
current-idx (count frame-shapes)
z-index z-index]
(let [children (get-in objects [current :shapes])
is-frame? (is-frame? current)
pending (if (not is-frame?)
(d/concat pending children)
pending)]
(if (empty? pending)
(-> z-index
(assoc current current-idx))
(recur (peek pending)
(pop pending)
(dec current-idx)
(assoc z-index current current-idx))))))))
;; The z-index is really calculated per-frame. Every frame will have its own
;; internal z-index. To calculate the "final" z-index we add the shape z-index with
;; the z-index of its frame. This way we can update the z-index per frame without
;; the need of recalculate all the frames
(defn calculate-z-index
"Given a collection of shapes calculates their z-index. Greater index
means is displayed over other shapes with less index."
[objects]
(let [frames (helpers/select-frames objects)
z-index (calculate-frame-z-index {} uuid/zero objects)]
(->> frames
(map :id)
(reduce #(calculate-frame-z-index %1 %2 objects) z-index))))
(defn update-z-index
"Updates the z-index given a set of ids to change and the old and new objects
representations"
[z-index changed-ids old-objects new-objects]
(let [old-frames (into #{} (map #(get-in old-objects [% :frame-id])) changed-ids)
new-frames (into #{} (map #(get-in new-objects [% :frame-id])) changed-ids)
changed-frames (set/union old-frames new-frames)
frames (->> (helpers/select-frames new-objects)
(map :id)
(filter #(contains? changed-frames %)))
z-index (calculate-frame-z-index z-index uuid/zero new-objects)]
(->> frames
(reduce #(calculate-frame-z-index %1 %2 new-objects) z-index))))
(defn generate-child-parent-index
[objects]
(reduce-kv
(fn [index id obj]
(assoc index id (:parent-id obj)))
{} objects))
(defn generate-child-all-parents-index
"Creates an index where the key is the shape id and the value is a set
with all the parents"
([objects]
(generate-child-all-parents-index objects (vals objects)))
([objects shapes]
(let [shape->parents
(fn [shape]
(->> (helpers/get-parents (:id shape) objects)
(into [])))]
(->> shapes
(map #(vector (:id %) (shape->parents %)))
(into {})))))
(defn create-mask-index
"Retrieves the mask information for an object"
[objects parents-index]
(let [retrieve-masks
(fn [id parents]
(->> parents
(map #(get objects %))
(filter #(:masked-group? %))
;; Retrieve the masking element
(mapv #(get objects (->> % :shapes first)))))]
(->> parents-index
(d/mapm retrieve-masks))))

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

@ -63,8 +63,6 @@
{:type :path
:name "Path"
:fill-color "#000000"
:fill-opacity 0
:stroke-style :solid
:stroke-alignment :center
:stroke-width 2

59
common/app/common/pages/migrations.cljc
View file

@ -163,3 +163,62 @@
(-> data
(update :components #(d/mapm update-container %))
(update :pages-index #(d/mapm update-container %)))))
;; Remove interactions pointing to deleted frames
(defmethod migrate 7
[data]
(letfn [(update-object [page _ object]
(d/update-when object :interactions
(fn [interactions]
(filterv #(get-in page [:objects (:destination %)])
interactions))))
(update-page [_ page]
(update page :objects #(d/mapm (partial update-object page) %)))]
(update data :pages-index #(d/mapm update-page %))))
;; Remove groups without any shape, both in pages and components
(defmethod migrate 8
[data]
(letfn [(clean-parents [obj deleted?]
(d/update-when obj :shapes
(fn [shapes]
(into [] (remove deleted?) shapes))))
(obj-is-empty? [obj]
(and (= (:type obj) :group)
(or (empty? (:shapes obj))
(nil? (:selrect obj)))))
(clean-objects [objects]
(loop [entries (seq objects)
deleted #{}
result objects]
(let [[id obj :as entry] (first entries)]
(if entry
(if (obj-is-empty? obj)
(recur (rest entries)
(conj deleted id)
(dissoc result id))
(recur (rest entries)
deleted
result))
[(count deleted)
(d/mapm #(clean-parents %2 deleted) result)]))))
(clean-container [_ container]
(loop [n 0
objects (:objects container)]
(let [[deleted objects] (clean-objects objects)]
(if (and (pos? deleted) (< n 1000))
(recur (inc n) objects)
(assoc container :objects objects)))))]
(-> data
(update :pages-index #(d/mapm clean-container %))
(d/update-when :components #(d/mapm clean-container %)))))

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

@ -90,6 +90,7 @@
;;; COLORS
(s/def :internal.color/name ::string)
(s/def :internal.color/path (s/nilable ::string))
(s/def :internal.color/value (s/nilable ::string))
(s/def :internal.color/color (s/nilable ::string))
(s/def :internal.color/opacity (s/nilable ::safe-number))
@ -98,13 +99,13 @@
(s/def ::color
(s/keys :opt-un [::id
:internal.color/name
:internal.color/path
:internal.color/value
:internal.color/color
:internal.color/opacity
:internal.color/gradient]))
;;; SHADOW EFFECT
(s/def :internal.shadow/id uuid?)
@ -380,6 +381,7 @@
(s/def :internal.typography/id ::id)
(s/def :internal.typography/name ::string)
(s/def :internal.typography/path (s/nilable ::string))
(s/def :internal.typography/font-id ::string)
(s/def :internal.typography/font-family ::string)
(s/def :internal.typography/font-variant-id ::string)
@ -401,7 +403,8 @@
:internal.typography/font-style
:internal.typography/line-height
:internal.typography/letter-spacing
:internal.typography/text-transform]))
:internal.typography/text-transform]
:opt-un [:internal.typography/path]))
(s/def :internal.file/pages
(s/coll-of ::uuid :kind vector?))

59
common/app/common/spec.cljc
View file

@ -6,7 +6,7 @@
(ns app.common.spec
"Data manipulation and query helper functions."
(:refer-clojure :exclude [assert])
(:refer-clojure :exclude [assert bytes?])
#?(:cljs (:require-macros [app.common.spec :refer [assert]]))
(:require
#?(:clj [clojure.spec.alpha :as s]
@ -108,6 +108,20 @@
(s/def ::point gpt/point?)
(s/def ::id ::uuid)
(defn bytes?
"Test if a first parameter is a byte
array or not."
[x]
(if (nil? x)
false
#?(:clj (= (Class/forName "[B")
(.getClass ^Object x))
:cljs (or (instance? js/Uint8Array x)
(instance? js/ArrayBuffer x)))))
(s/def ::bytes bytes?)
(s/def ::safe-integer
#(and
(int? %)
@ -123,29 +137,34 @@
;; --- SPEC: email
(def email-re #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
(let [re #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+"
cfn (fn [v]
(if (string? v)
(if-let [matches (re-seq re v)]
(first matches)
(do ::s/invalid))
::s/invalid))]
(s/def ::email (s/conformer cfn str)))
(s/def ::email
(s/conformer
(fn [v]
(if (string? v)
(if-let [matches (re-seq email-re v)]
(first matches)
(do ::s/invalid))
::s/invalid))
str))
;; --- SPEC: set-of-str
(letfn [(conformer [s]
(cond
(string? s) (into #{} (str/split s #"\s*,\s*"))
(set? s) (if (every? string? s)
s
::s/invalid)
:else ::s/invalid))
(unformer [s]
(str/join "," s))]
(s/def ::set-of-str (s/conformer conformer unformer)))
(s/def ::set-of-str
(s/conformer
(fn [s]
(let [xform (comp
(filter string?)
(remove str/empty?)
(remove str/blank?))]
(cond
(string? s) (->> (str/split s #"\s*,\s*")
(into #{} xform))
(set? s) (into #{} xform s)
:else ::s/invalid)))
(fn [s]
(str/join "," s))))
;; --- Macros

12
common/app/common/uuid_impl.js
View file

@ -12,17 +12,13 @@ goog.provide("app.common.uuid_impl");
goog.scope(function() {
const core = cljs.core;
const global = goog.global;
const self = app.common.uuid_impl;
const fill = (() => {
if (typeof window === "object" && typeof window.crypto !== "undefined") {
if (typeof global.crypto !== "undefined") {
return (buf) => {
window.crypto.getRandomValues(buf);
return buf;
};
} else if (typeof self === "object" && typeof self.crypto !== "undefined") {
return (buf) => {
self.crypto.getRandomValues(buf);
global.crypto.getRandomValues(buf);
return buf;
};
} else if (typeof require === "function") {
@ -34,7 +30,7 @@ goog.scope(function() {
};
} else {
// FALLBACK
console.warn("No high quality RNG available, switching back to Math.random.");
console.warn("No SRNG available, switching back to Math.random.");
return (buf) => {
for (let i = 0, r; i < buf.length; i++) {

2
docker/devenv/Dockerfile
View file

@ -6,7 +6,7 @@ ARG DEBIAN_FRONTEND=noninteractive
ENV NODE_VERSION=v14.16.1 \
CLOJURE_VERSION=1.10.3.822 \
CLJKONDO_VERSION=2021.04.23 \
BABASHKA_VERSION=0.3.5 \
BABASHKA_VERSION=0.4.0 \
LANG=en_US.UTF-8 \
LC_ALL=en_US.UTF-8

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

@ -38,6 +38,7 @@ services:
environment:
- EXTERNAL_UID=${CURRENT_USER_ID}
- PENPOT_SECRET_KEY=super-secret-devenv-key
# STMP setup
- PENPOT_SMTP_ENABLED=true
- PENPOT_SMTP_DEFAULT_FROM=no-reply@example.com

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

@ -46,7 +46,7 @@ http {
listen 3449 default_server;
server_name _;
client_max_body_size 5M;
client_max_body_size 20M;
charset utf-8;
proxy_http_version 1.1;

1
docker/images/files/config.js
View file

@ -9,3 +9,4 @@
//var penpotOIDCClientID = "<oidc-client-id-here>";
//var penpotLoginWithLDAP = <true|false>;
//var penpotRegistrationEnabled = <true|false>;
//var penpotAnalyticsEnabled = <true|false>;

9
docker/images/files/nginx-entrypoint.sh
View file

@ -97,6 +97,14 @@ update_registration_enabled() {
fi
}
update_registration_enabled() {
if [ -n "$PENPOT_ANALYTICS_ENABLED" ]; then
sed -i \
-e "s|^//var penpotAnalyticsEnabled = .*;|var penpotAnalyticsEnabled = $PENPOT_ANALYTICS_ENABLED;|g" \
"$1"
fi
}
update_public_uri /var/www/app/js/config.js
update_demo_warning /var/www/app/js/config.js
update_allow_demo_users /var/www/app/js/config.js
@ -106,5 +114,6 @@ update_github_client_id /var/www/app/js/config.js
update_oidc_client_id /var/www/app/js/config.js
update_login_with_ldap /var/www/app/js/config.js
update_registration_enabled /var/www/app/js/config.js
update_analytics_enabled /var/www/app/js/config.js
exec "$@";

10
exporter/shadow-cljs.edn
View file

@ -1,11 +1,13 @@
{:dependencies
[[funcool/promesa "6.0.0"]
[[com.cognitect/transit-cljs "0.8.269"]
[danlentz/clj-uuid "0.1.9"]
[frankiesardo/linked "1.3.0"]
[funcool/cuerdas "2021.05.02-0"]
[funcool/promesa "6.0.0"]
[integrant/integrant "0.8.0"]
[lambdaisland/glogi "1.0.106"]
[metosin/reitit-core "0.5.13"]
[com.cognitect/transit-cljs "0.8.269"]
[frankiesardo/linked "1.3.0"]]
[lambdaisland/uri "1.4.54"]
[metosin/reitit-core "0.5.13"]]
:source-paths ["src" "vendor" "../common"]
:jvm-opts ["-Xmx512m" "-Xms50m" "-XX:+UseSerialGC"]

102
exporter/src/app/browser.cljs
View file

@ -6,11 +6,17 @@
(ns app.browser
(:require
["puppeteer-cluster" :as ppc]
[app.common.data :as d]
[app.config :as cf]
[lambdaisland.glogi :as log]
[promesa.core :as p]
["puppeteer-cluster" :as ppc]))
[promesa.core :as p]))
(def USER-AGENT
;; --- BROWSER API
(def default-timeout 30000)
(def default-viewport {:width 1920 :height 1080 :scale 1})
(def default-user-agent
(str "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 "
"(KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36"))
@ -20,15 +26,25 @@
(let [page (unchecked-get props "page")]
(f page)))))
(defn emulate!
[page {:keys [viewport user-agent scale]
:or {user-agent USER-AGENT
scale 1}}]
(let [[width height] viewport]
(.emulate ^js page #js {:viewport #js {:width width
:height height
:deviceScaleFactor scale}
:userAgent user-agent})))
(defn set-cookie!
[page {:keys [key value domain]}]
(.setCookie ^js page #js {:name key
:value value
:domain domain}))
(defn configure-page!
[page {:keys [timeout cookie user-agent viewport]}]
(let [timeout (or timeout default-timeout)
user-agent (or user-agent default-user-agent)
viewport (d/merge default-viewport viewport)]
(p/do!
(.setViewport ^js page #js {:width (:width viewport)
:height (:height viewport)
:deviceScaleFactor (:scale viewport)})
(.setUserAgent ^js page user-agent)
(.setDefaultTimeout ^js page timeout)
(when cookie
(set-cookie! page cookie)))))
(defn navigate!
([page url] (navigate! page url nil))
@ -40,10 +56,9 @@
[page ms]
(.waitForTimeout ^js page ms))
(defn wait-for
([page selector] (wait-for page selector nil))
([page selector {:keys [visible] :or {visible false}}]
([page selector {:keys [visible timeout] :or {visible false timeout 10000}}]
(.waitForSelector ^js page selector #js {:visible visible})))
(defn screenshot
@ -68,30 +83,39 @@
[frame selector]
(.$$ ^js frame selector))
(defn set-cookie!
[page {:keys [key value domain]}]
(.setCookie ^js page #js {:name key
:value value
:domain domain}))
(defn start!
([] (start! nil))
([{:keys [concurrency concurrency-strategy]
:or {concurrency 10
concurrency-strategy :incognito}}]
(let [ccst (case concurrency-strategy
:browser (.-CONCURRENCY_BROWSER ^js ppc/Cluster)
:incognito (.-CONCURRENCY_CONTEXT ^js ppc/Cluster)
:page (.-CONCURRENCY_PAGE ^js ppc/Cluster))
opts #js {:concurrency ccst
:maxConcurrency concurrency
:puppeteerOptions #js {:args #js ["--no-sandbox"]}}]
(.launch ^js ppc/Cluster opts))))
;; --- BROWSER STATE
(defn stop!
[instance]
(p/do!
(.idle ^js instance)
(.close ^js instance)
(log/info :msg "shutdown headless browser")
nil))
(def instance (atom nil))
(defn- create-browser
[concurrency strategy]
(let [strategy (case strategy
:browser (.-CONCURRENCY_BROWSER ^js ppc/Cluster)
:incognito (.-CONCURRENCY_CONTEXT ^js ppc/Cluster)
:page (.-CONCURRENCY_PAGE ^js ppc/Cluster))
opts #js {:concurrency strategy
:maxConcurrency concurrency
:puppeteerOptions #js {:args #js ["--no-sandbox"]}}]
(.launch ^js ppc/Cluster opts)))
(defn init
[]
(let [concurrency (cf/get :browser-concurrency)
strategy (cf/get :browser-strategy)]
(-> (create-browser concurrency strategy)
(p/then #(reset! instance %))
(p/catch (fn [error]
(log/error :msg "failed to initialize browser")
(js/console.error error))))))
(defn stop
[]
(if-let [instance @instance]
(p/do!
(.idle ^js instance)
(.close ^js instance)
(log/info :msg "shutdown headless browser"))
(p/resolved nil)))

66
exporter/src/app/config.cljs
View file

@ -5,22 +5,62 @@
;; Copyright (c) UXBOX Labs SL
(ns app.config
(:refer-clojure :exclude [get])
(:require
[app.common.data :as d]
["process" :as process]
[cljs.pprint]
[cuerdas.core :as str]))
[cuerdas.core :as str]
[app.common.spec :as us]
[cljs.spec.alpha :as s]
[cljs.core :as c]
[lambdaisland.uri :as u]))
(defn- keywordize
[s]
(-> (str/kebab s)
(str/keyword)))
(def defaults
{:public-uri "http://localhost:3449"
:http-server-port 6061
:browser-concurrency 5
:browser-strategy :incognito})
(defonce env
(let [env (unchecked-get process "env")]
(persistent!
(reduce #(assoc! %1 (keywordize %2) (unchecked-get env %2))
(transient {})
(js/Object.keys env)))))
(s/def ::public-uri ::us/string)
(s/def ::http-server-port ::us/integer)
(s/def ::browser-concurrency ::us/integer)
(s/def ::browser-strategy ::us/keyword)
(defonce config
{:public-uri (:penpot-public-uri env "http://localhost:3449")})
(s/def ::config
(s/keys :opt-un [::public-uri
::http-server-port
::browser-concurrency
::browser-strategy]))
(defn- read-env
[prefix]
(let [env (unchecked-get process "env")
kwd (fn [s] (-> (str/kebab s) (str/keyword)))
prefix (str prefix "_")
len (count prefix)]
(reduce (fn [res key]
(let [val (unchecked-get env key)
key (str/lower key)]
(cond-> res
(str/starts-with? key prefix)
(assoc (kwd (subs key len)) val))))
{}
(js/Object.keys env))))
(defn- prepare-config
[]
(let [env (read-env "penpot")
env (d/without-nils env)
data (merge defaults env)]
(us/conform ::config data)))
(def config
(atom (prepare-config)))
(defn get
"A configuration getter."
([key]
(c/get @config key))
([key default]
(c/get @config key default)))

13
exporter/src/app/core.cljs
View file

@ -21,10 +21,9 @@
(defn start
[& args]
(log/info :msg "initializing")
(p/let [browser (bwr/start!)
server (http/start! {:browser browser})]
(reset! state {:http server
:browser browser})))
(p/do!
(bwr/init)
(http/init)))
(def main start)
@ -35,8 +34,6 @@
(log/info :msg "stoping")
(p/do!
(when-let [instance (:browser @state)]
(bwr/stop! instance))
(when-let [instance (:http @state)]
(http/stop! instance))
(bwr/stop)
(http/stop)
(done)))

36
exporter/src/app/http.cljs
View file

@ -6,29 +6,33 @@
(ns app.http
(:require
[app.config :as cf]
[app.http.export :refer [export-handler]]
[app.http.thumbnail :refer [thumbnail-handler]]
[app.http.impl :as impl]
[lambdaisland.glogi :as log]
[promesa.core :as p]
[reitit.core :as r]))
(def routes
[["/export/thumbnail" {:handler thumbnail-handler}]
["/export" {:handler export-handler}]])
[["/export" {:handler export-handler}]])
(defn start!
[extra]
(log/info :msg "starting http server" :port 6061)
(def instance (atom nil))
(defn init
[]
(let [router (r/router routes)
handler (impl/handler router extra)
server (impl/server handler)]
(.listen server 6061)
(p/resolved server)))
handler (impl/handler router)
server (impl/server handler)
port (cf/get :http-server-port 6061)]
(.listen server port)
(log/info :msg "starting http server" :port port)
(reset! instance server)))
(defn stop!
[server]
(p/create (fn [resolve]
(.close server (fn []
(log/info :msg "shutdown http server")
(resolve))))))
(defn stop
[]
(if-let [server @instance]
(p/create (fn [resolve]
(.close server (fn []
(log/info :msg "shutdown http server")
(resolve)))))
(p/resolved nil)))

66
exporter/src/app/http/export.cljs
View file

@ -6,15 +6,15 @@
(ns app.http.export
(:require
[app.http.export-bitmap :as bitmap]
[app.http.export-svg :as svg]
[app.common.exceptions :as exc :include-macros true]
[app.common.spec :as us]
[app.renderer.bitmap :as rb]
[app.renderer.svg :as rs]
[app.zipfile :as zip]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[lambdaisland.glogi :as log]
[promesa.core :as p]
[app.common.exceptions :as exc :include-macros true]
[app.common.spec :as us]))
[promesa.core :as p]))
(s/def ::name ::us/string)
(s/def ::page-id ::us/uuid)
@ -38,42 +38,44 @@
(declare attach-filename)
(defn export-handler
[{:keys [params browser cookies] :as request}]
[{:keys [params cookies] :as request}]
(let [{:keys [exports page-id file-id object-id name]} (us/conform ::handler-params params)
token (.get ^js cookies "auth-token")]
(case (count exports)
0 (exc/raise :type :validation :code :missing-exports)
1 (handle-single-export
request
(assoc (first exports)
:name name
:token token
:file-id file-id
:page-id page-id
:object-id object-id))
(handle-multiple-export
request
(map (fn [item]
(assoc item
:name name
:token token
:file-id file-id
:page-id page-id
:object-id object-id)) exports)))))
0 (exc/raise :type :validation
:code :missing-exports)
1 (-> (first exports)
(assoc :name name)
(assoc :token token)
(assoc :file-id file-id)
(assoc :page-id page-id)
(assoc :object-id object-id)
(handle-single-export))
(->> exports
(map (fn [item]
(-> item
(assoc :name name)
(assoc :token token)
(assoc :file-id file-id)
(assoc :page-id page-id)
(assoc :object-id object-id))))
(handle-multiple-export)))))
(defn- handle-single-export
[{:keys [browser]} params]
(p/let [result (perform-export browser params)]
[params]
(p/let [result (perform-export params)]
{:status 200
:body (:content result)
:headers {"content-type" (:mime-type result)
"content-length" (:length result)}}))
(defn- handle-multiple-export
[{:keys [browser]} exports]
[exports]
(let [proms (->> exports
(attach-filename)
(map (partial perform-export browser)))]
(map perform-export))]
(-> (p/all proms)
(p/then (fn [results]
(reduce #(zip/add! %1 (:filename %2) (:content %2)) (zip/create) results)))
@ -83,11 +85,11 @@
:body (.generateNodeStream ^js fzip)})))))
(defn- perform-export
[browser params]
[params]
(case (:type params)
:png (bitmap/export browser params)
:jpeg (bitmap/export browser params)
:svg (svg/export browser params)))
:png (rb/render params)
:jpeg (rb/render params)
:svg (rs/render params)))
(defn- find-filename-candidate
[params used]

80
exporter/src/app/http/export_bitmap.cljs
View file

@ -1,80 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.http.export-bitmap
(:require
[cuerdas.core :as str]
[app.browser :as bwr]
[app.config :as cfg]
[lambdaisland.glogi :as log]
[cljs.spec.alpha :as s]
[promesa.core :as p]
[app.common.exceptions :as exc :include-macros true]
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.spec :as us])
(:import
goog.Uri))
(defn screenshot-object
[browser {:keys [file-id page-id object-id token scale type]}]
(letfn [(handle [page]
(let [path (str "/render-object/" file-id "/" page-id "/" object-id)
uri (doto (Uri. (:public-uri cfg/config))
(.setPath "/")
(.setFragment path))
cookie {:domain (str (.getDomain uri)
":"
(.getPort uri))
:key "auth-token"
:value token}]
(log/info :uri (.toString uri))
(screenshot page (.toString uri) cookie)))
(screenshot [page uri cookie]
(p/do!
(bwr/emulate! page {:viewport [1920 1080]
:scale scale})
(bwr/set-cookie! page cookie)
(bwr/navigate! page uri)
(bwr/eval! page (js* "() => document.body.style.background = 'transparent'"))
(p/let [dom (bwr/select page "#screenshot")]
(case type
:png (bwr/screenshot dom {:omit-background? true :type type})
:jpeg (bwr/screenshot dom {:omit-background? false :type type})))))]
(bwr/exec! browser handle)))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::export-params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::filename]))
(defn export
[browser params]
(us/assert ::export-params params)
(p/let [content (screenshot-object browser params)]
{:content content
:filename (or (:filename params)
(str (:name params)
(:suffix params "")
(case (:type params)
:png ".png"
:jpeg ".jpg")))
:length (alength content)
:mime-type (case (:type params)
:png "image/png"
:jpeg "image/jpeg")}))

47
exporter/src/app/http/impl.cljs
View file

@ -13,25 +13,15 @@
[app.util.transit :as t]
[cuerdas.core :as str]
[lambdaisland.glogi :as log]
[lambdaisland.uri :as u]
[promesa.core :as p]
[reitit.core :as r])
(:import
goog.Uri))
(defn- query-params
"Given goog.Uri, read query parameters into Clojure map."
[^Uri uri]
(let [^js q (.getQueryData uri)]
(->> q
(.getKeys)
(map (juxt keyword #(.get q %)))
(into {}))))
[reitit.core :as r]))
(defn- match
[router ctx]
(let [uri (.parse Uri (unchecked-get ctx "originalUrl"))]
(when-let [match (r/match-by-path router (.getPath ^js uri))]
(assoc match :query-params (query-params uri)))))
(let [uri (u/uri (unchecked-get ctx "originalUrl"))]
(when-let [match (r/match-by-path router (:path uri))]
(assoc match :query-params (u/query-string->map (:query uri))))))
(defn- handle-error
[error request]
@ -48,17 +38,21 @@
:headers {"content-type" "text/html"}
:body (str "<pre style='font-size:16px'>" (:explain data) "</pre>\n")}))
(and (= :internal type)
(= :browser-not-ready code))
{:status 503
:headers {"x-error" (t/encode data)}
:body ""}
:else
(do
(log/error :msg "Unexpected error"
:error error)
(js/console.error error)
{:status 500
:headers {"x-metadata" (t/encode {:type :unexpected
:message (ex-message error)})}
:headers {"x-error" (t/encode data)}
:body ""}))))
(defn- handle-response
[ctx {:keys [body headers status] :or {headers {} status 200}}]
(run! (fn [[k v]] (.set ^js ctx k v)) headers)
@ -89,17 +83,16 @@
(t/decode))))))))
(defn- wrap-handler
[f extra]
[f]
(fn [ctx]
(p/let [cookies (unchecked-get ctx "cookies")
headers (parse-headers ctx)
body (parse-body ctx)
request (assoc extra
:method (str/lower (unchecked-get ctx "method"))
:body body
:ctx ctx
:headers headers
:cookies cookies)]
request {:method (str/lower (unchecked-get ctx "method"))
:body body
:ctx ctx
:headers headers
:cookies cookies}]
(-> (p/do! (f request))
(p/then (fn [rsp]
(when (map? rsp)
@ -131,10 +124,10 @@
(.createServer http @handler))
(defn handler
[router extra]
[router]
(let [instance (doto (new koa)
(.use (-> (router-handler router)
(wrap-handler extra))))]
(wrap-handler))))]
(specify! instance
cljs.core/IDeref
(-deref [_]

43
exporter/src/app/http/thumbnail.cljs
View file

@ -1,43 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.http.thumbnail
(:require
[app.common.exceptions :as exc :include-macros true]
[app.common.spec :as us]
[app.http.export-bitmap :as bitmap]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[lambdaisland.glogi :as log]
[promesa.core :as p]))
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::handler-params
(s/keys :req-un [::page-id ::file-id ::object-id]))
(declare handle-single-export)
(declare handle-multiple-export)
(declare perform-export)
(declare attach-filename)
(defn thumbnail-handler
[{:keys [params browser cookies] :as request}]
(let [{:keys [page-id file-id object-id]} (us/conform ::handler-params params)
params {:token (.get ^js cookies "auth-token")
:file-id file-id
:page-id page-id
:object-id object-id
:scale 0.3
:type :jpeg}]
(p/let [content (bitmap/screenshot-object browser params)]
{:status 200
:body content
:headers {"content-type" "image/jpeg"
"content-length" (alength content)}})))

95
exporter/src/app/renderer/bitmap.cljs Normal file
View file

@ -0,0 +1,95 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.renderer.bitmap
"A bitmap renderer."
(:require
[app.browser :as bw]
[app.common.data :as d]
[app.common.exceptions :as ex :include-macros true]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.config :as cf]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[lambdaisland.uri :as u]
[lambdaisland.glogi :as log]
[promesa.core :as p]))
(defn create-cookie
[uri token]
(let [domain (str (:host uri)
(when (:port uri)
(str ":" (:port uri))))]
{:domain domain
:key "auth-token"
:value token}))
(defn screenshot-object
[browser {:keys [file-id page-id object-id token scale type]}]
(letfn [(handle [page]
(let [path (str "/render-object/" file-id "/" page-id "/" object-id)
uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/")
(assoc :fragment path))
cookie (create-cookie uri token)]
(screenshot page (str uri) cookie)))
(screenshot [page uri cookie]
(log/info :uri uri)
(let [viewport {:width 1920
:height 1080
:scale scale}
options {:viewport viewport
:cookie cookie}]
(p/do!
(bw/configure-page! page options)
(bw/navigate! page uri)
(bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
(bw/wait-for page "#screenshot")
(p/let [dom (bw/select page "#screenshot")]
(case type
:png (bw/screenshot dom {:omit-background? true :type type})
:jpeg (bw/screenshot dom {:omit-background? false :type type}))))))]
(bw/exec! browser handle)))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::render-params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::filename]))
(defn render
[params]
(us/assert ::render-params params)
(let [browser @bw/instance]
(when-not browser
(ex/raise :type :internal
:code :browser-not-ready
:hint "browser cluster is not initialized yet"))
(p/let [content (screenshot-object browser params)]
{:content content
:filename (or (:filename params)
(str (:name params)
(:suffix params "")
(case (:type params)
:png ".png"
:jpeg ".jpg")))
:length (alength content)
:mime-type (case (:type params)
:png "image/png"
:jpeg "image/jpeg")})))

102
exporter/src/app/http/export_svg.cljs → exporter/src/app/renderer/svg.cljs
View file

@ -4,24 +4,24 @@
;;
;; Copyright (c) UXBOX Labs SL
(ns app.http.export-svg
(ns app.renderer.svg
(:require
["path" :as path]
["xml-js" :as xml]
[app.browser :as bwr]
[app.browser :as bw]
[app.common.data :as d]
[app.common.exceptions :as exc :include-macros true]
[app.common.exceptions :as ex :include-macros true]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.config :as cfg]
[app.config :as cf]
[app.util.shell :as sh]
[cljs.spec.alpha :as s]
[clojure.walk :as walk]
[cuerdas.core :as str]
[lambdaisland.glogi :as log]
[promesa.core :as p])
(:import
goog.Uri))
[lambdaisland.uri :as u]
[app.renderer.bitmap :refer [create-cookie]]
[promesa.core :as p]))
(log/set-level "app.http.export-svg" :trace)
@ -67,7 +67,6 @@
(nil? d)
(str/empty? d)))))
(defn flatten-toplevel-svg-elements
"Flattens XML data structure if two nested top-side SVG elements found."
[item]
@ -165,7 +164,9 @@
;; objects.
(let [vbox (-> (get-in result ["attributes" "viewBox"])
(parse-viewbox))
transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y (/ width (:width vbox)) (/ height (:height vbox)))]
transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y
(/ width (:width vbox))
(/ height (:height vbox)))]
(-> result
(assoc "name" "g")
(assoc "attributes" {})
@ -212,8 +213,8 @@
(extract-single-node [node]
(log/trace :fn :extract-single-node)
(p/let [attrs (bwr/eval! node extract-element-attrs)
shot (bwr/screenshot node {:omit-background? true :type "png"})]
(p/let [attrs (bw/eval! node extract-element-attrs)
shot (bw/screenshot node {:omit-background? true :type "png"})]
{:id (unchecked-get attrs "id")
:x (unchecked-get attrs "x")
:y (unchecked-get attrs "y")
@ -235,12 +236,12 @@
(process-text-nodes [page]
(log/trace :fn :process-text-nodes)
(-> (bwr/select-all page "#screenshot foreignObject")
(-> (bw/select-all page "#screenshot foreignObject")
(p/then (fn [nodes] (p/all (map process-text-node nodes))))))
(extract-svg [page]
(p/let [dom (bwr/select page "#screenshot")
xmldata (bwr/eval! dom (fn [elem] (.-outerHTML ^js elem)))
(p/let [dom (bw/select page "#screenshot")
xmldata (bw/eval! dom (fn [elem] (.-outerHTML ^js elem)))
nodes (process-text-nodes page)
nodes (d/index-by :id nodes)
result (replace-text-nodes xmldata nodes)]
@ -252,31 +253,33 @@
result))
(render-in-page [page {:keys [uri cookie] :as rctx}]
(p/do!
(bwr/emulate! page {:viewport [1920 1080]
:scale 4})
(bwr/set-cookie! page cookie)
(bwr/navigate! page uri)
;; (bwr/wait-for page "#screenshot foreignObject" {:visible true})
(bwr/sleep page 2000)
;; (bwr/eval! page (js* "() => document.body.style.background = 'transparent'"))
page))
(let [viewport {:width 1920
:height 1080
:scale 4}
options {:viewport viewport
:timeout 15000
:cookie cookie}]
(p/do!
(bw/configure-page! page options)
(bw/navigate! page uri)
(bw/wait-for page "#screenshot")
(bw/sleep page 2000)
;; (bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
page)))
(handle [rctx page]
(p/let [page (render-in-page page rctx)]
(extract-svg page)))]
(let [path (str "/render-object/" file-id "/" page-id "/" object-id)
uri (doto (Uri. (:public-uri cfg/config))
(.setPath "/")
(.setFragment path))
rctx {:cookie {:domain (str (.getDomain uri) ":" (.getPort uri))
:key "auth-token"
:value token}
:uri (.toString uri)}]
(log/info :uri (.toString uri))
(bwr/exec! browser (partial handle rctx)))))
(let [path (str "/render-object/" file-id "/" page-id "/" object-id)
uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/")
(assoc :fragment path))
cookie (create-cookie uri token)
rctx {:cookie cookie
:uri (str uri)}]
(log/info :uri (:uri rctx))
(bw/exec! browser (partial handle rctx)))))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
@ -288,18 +291,25 @@
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::export-params
(s/def ::render-params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::file-id ::scale ::token]
:opt-un [::filename]))
(defn export
[browser params]
(us/assert ::export-params params)
(p/let [content (render-object browser params)]
{:content content
:filename (or (:filename params)
(str (:name params)
(:suffix params "")
".svg"))
:length (alength content)
:mime-type "image/svg+xml"}))
(defn render
[params]
(us/assert ::render-params params)
(let [browser @bw/instance]
(when-not browser
(ex/raise :type :internal
:code :browser-not-ready
:hint "browser cluster is not initialized yet"))
(p/let [content (render-object browser params)]
{:content content
:filename (or (:filename params)
(str (:name params)
(:suffix params "")
".svg"))
:length (alength content)
:mime-type "image/svg+xml"})))

2
exporter/src/app/util/transit.cljs
View file

@ -25,5 +25,5 @@
(defn encode
[data]
(let [w (t/writer :json {:handlers +write-handlers+})]
(let [w (t/writer :json-verbose {:handlers +write-handlers+})]
(t/write w data)))

30
exporter/yarn.lock
View file

@ -11,9 +11,9 @@
regenerator-runtime "^0.13.4"
"@types/node@*":
version "15.0.1"
resolved "https://registry.yarnpkg.com/@types/node/-/node-15.0.1.tgz#ef34dea0881028d11398be5bf4e856743e3dc35a"
integrity sha512-TMkXt0Ck1y0KKsGr9gJtWGjttxlZnnvDtphxUOSd0bfaR6Q1jle+sPvrzNR1urqYTWMinoKvjKfXUGsumaO1PA==
version "15.0.2"
resolved "https://registry.yarnpkg.com/@types/node/-/node-15.0.2.tgz#51e9c0920d1b45936ea04341aa3e2e58d339fb67"
integrity sha512-p68+a+KoxpoB47015IeYZYRrdqMUcpbK8re/zpFB8Ld46LHC1lPEbp3EXgkEhAYEcPvjJF6ZO+869SQ0aH1dcA==
"@types/yauzl@^2.9.1":
version "2.9.1"
@ -272,9 +272,9 @@ cookies@~0.8.0:
keygrip "~1.1.0"
core-js-pure@^3.0.0:
version "3.11.2"
resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.11.2.tgz#10e3b35788c00f431bc0d601d7551475ec3e792c"
integrity sha512-DQxdEKm+zFsnON7ZGOgUAQXBt1UJJ01tOzN/HgQ7cNf0oEHW1tcBLfCQQd1q6otdLu5gAdvKYxKHAoXGwE/kiQ==
version "3.12.1"
resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.12.1.tgz#934da8b9b7221e2a2443dc71dfa5bd77a7ea00b8"
integrity sha512-1cch+qads4JnDSWsvc7d6nzlKAippwjUlf6vykkTLW53VSV+NkE6muGBToAjEA8pG90cSfcud3JgVmW2ds5TaQ==
core-util-is@~1.0.0:
version "1.0.2"
@ -492,9 +492,9 @@ get-stream@^5.1.0:
pump "^3.0.0"
glob@^7.1.3:
version "7.1.6"
resolved "https://registry.yarnpkg.com/glob/-/glob-7.1.6.tgz#141f33b81a7c2492e125594307480c46679278a6"
integrity sha512-LwaxwyZ72Lk7vZINtNNrywX0ZuLyStrdDtabefZKAY5ZGJhVtgdznluResxNmPitE0SAO+O26sWTHeKSI2wMBA==
version "7.1.7"
resolved "https://registry.yarnpkg.com/glob/-/glob-7.1.7.tgz#3b193e9233f01d42d0b3f78294bbeeb418f94a90"
integrity sha512-OvD9ENzPLbegENnYP5UUfJIirTg4+XwMWGaQfQTY0JenxNvvIKP3U3/tAQSPIu/lHxXYSZmpXlUHeqAIdKzBLQ==
dependencies:
fs.realpath "^1.0.0"
inflight "^1.0.4"
@ -618,9 +618,9 @@ inherits@2.0.3:
integrity sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=
is-generator-function@^1.0.7:
version "1.0.8"
resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.8.tgz#dfb5c2b120e02b0a8d9d2c6806cd5621aa922f7b"
integrity sha512-2Omr/twNtufVZFr1GhxjOMFPAj2sjc/dKaIqBhvo4qciXfJmITGH6ZGd8eZYNHza8t1y0e01AuqRhJwfWp26WQ==
version "1.0.9"
resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.9.tgz#e5f82c2323673e7fcad3d12858c83c4039f6399c"
integrity sha512-ZJ34p1uvIfptHCN7sFTjGibB9/oBg17sHqzDLfuwhvmN/qLVvIQXRQ8licZQ35WJ8KuEQt/etnnzQFI9C9Ue/A==
isarray@^1.0.0, isarray@~1.0.0:
version "1.0.0"
@ -982,9 +982,9 @@ puppeteer-cluster@^0.22.0:
debug "^4.1.1"
puppeteer@^9.1.0:
version "9.1.0"
resolved "https://registry.yarnpkg.com/puppeteer/-/puppeteer-9.1.0.tgz#0530ed1f595088eefd078c8f1f7618d00f216a56"
integrity sha512-+BWwEKYQ9oBTUcDYwfgnVPlHSEYqD4sXsMqQf70vSlTE6YIuXujc7zKgO3FyZNJYVrdrUppy/LLwGF1IRacQMQ==
version "9.1.1"
resolved "https://registry.yarnpkg.com/puppeteer/-/puppeteer-9.1.1.tgz#f74b7facf86887efd6c6b9fabb7baae6fdce012c"
integrity sha512-W+nOulP2tYd/ZG99WuZC/I5ljjQQ7EUw/jQGcIb9eu8mDlZxNY2SgcJXTLG9h5gRvqA3uJOe4hZXYsd3EqioMw==
dependencies:
debug "^4.1.0"
devtools-protocol "0.0.869402"

1
frontend/dev/cljs/user.cljs
View file

@ -1 +0,0 @@
(ns cljs.user)

29
frontend/gulpfile.js
View file

@ -17,6 +17,7 @@ const mkdirp = require("mkdirp");
const rimraf = require("rimraf");
const sass = require("sass");
const gettext = require("gettext-parser");
const marked = require("marked");
const mapStream = require("map-stream");
const paths = {};
@ -32,7 +33,7 @@ paths.dist = "./target/dist/";
// Templates
function readLocales() {
const langs = ["ca", "de", "el", "en", "es", "fr", "tr", "ru", "zh_cn"];
const langs = ["ca", "de", "el", "en", "es", "fr", "tr", "ru", "zh_CN", "pt_BR", "ro"];
const result = {};
for (let lang of langs) {
@ -45,17 +46,35 @@ function readLocales() {
for (let key of Object.keys(trdata)) {
if (key === "") continue;
const comments = trdata[key].comments || {};
if (l.isNil(result[key])) {
result[key] = {};
}
const msgstr = trdata[key].msgstr;
if (msgstr.length === 1) {
result[key][lang] = msgstr[0];
const isMarkdown = l.includes(comments.flag, "markdown");
const msgs = trdata[key].msgstr;
if (msgs.length === 1) {
let message = msgs[0];
if (isMarkdown) {
message = marked.parseInline(message);
}
result[key][lang] = message;
} else {
result[key][lang] = msgstr;
result[key][lang] = msgs.map((item) => {
if (isMarkdown) {
return marked.parseInline(item);
} else {
return item;
}
});
}
// if (key === "modals.delete-font.title") {
// console.dir(trdata[key], {depth:10});
// console.dir(result[key], {depth:10});
// }
}
}

13
frontend/package.json
View file

@ -27,26 +27,31 @@
"gulp-sourcemaps": "^3.0.0",
"gulp-svg-sprite": "^1.5.0",
"map-stream": "0.0.7",
"marked": "^2.0.3",
"mkdirp": "^1.0.4",
"postcss": "^8.2.7",
"postcss": "^8.2.15",
"postcss-clean": "^1.2.2",
"rimraf": "^3.0.0",
"sass": "^1.32.8",
"shadow-cljs": "^2.11.20"
"shadow-cljs": "2.12.6"
},
"dependencies": {
"date-fns": "^2.21.1",
"date-fns": "^2.21.3",
"draft-js": "^0.11.7",
"highlight.js": "^10.6.0",
"js-beautify": "^1.13.5",
"luxon": "^1.26.0",
"mousetrap": "^1.6.5",
"opentype.js": "^1.3.3",
"randomcolor": "^0.6.2",
"react": "~17.0.1",
"react-dom": "~17.0.1",
"rxjs": "~7.0.0-beta.12",
"react-virtualized": "^9.22.3",
"rxjs": "~7.0.1",
"sax": "^1.2.4",
"source-map-support": "^0.5.16",
"tdigest": "^0.1.1",
"ua-parser-js": "^0.7.28",
"xregexp": "^5.0.1"
}
}

BIN
frontend/resources/images/features/custom-fonts.gif Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 1.1 MiB

BIN
frontend/resources/images/features/performance.gif Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 679 KiB

BIN
frontend/resources/images/features/scale-text.gif Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 472 KiB

BIN
frontend/resources/images/features/shapes-to-path.gif Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 310 KiB

1
frontend/resources/styles/common/dependencies/colors.scss
View file

@ -23,6 +23,7 @@ $color-info: #59b9e2;
$color-ocean: #4285f4;
$color-component: #76B0B8;
$color-component-highlight: #00E0FF;
$color-pink: #feecfc;
// Gray scale
$color-gray-10: #E3E3E3;

1
frontend/resources/styles/main-default.scss
View file

@ -63,6 +63,7 @@
@import "main/partials/dashboard-sidebar";
@import "main/partials/dashboard-team";
@import "main/partials/dashboard-settings";
@import "main/partials/dashboard-fonts";
@import "main/partials/debug-icons-preview";
@import "main/partials/editable-label";
@import "main/partials/left-toolbar";

234
frontend/resources/styles/main/partials/dashboard-fonts.scss Normal file
View file

@ -0,0 +1,234 @@
.dashboard-fonts {
display: flex;
flex-direction: column;
align-items: center;
.dashboard-installed-fonts {
max-width: 1000px;
width: 100%;
display: flex;
margin-top: $big;
flex-direction: column;
h3 {
font-size: $fs14;
color: $color-gray-30;
margin: $x-small;
}
.font-item {
color: $color-black;
}
}
.installed-fonts-header {
color: $color-gray-40;
display: flex;
height: 40px;
font-size: $fs12;
background-color: $color-white;
align-items: center;
padding: 0px $big;
> .family {
min-width: 200px;
width: 200px;
}
> .variants {
padding-left: 12px;
}
.search-input {
display: flex;
flex-grow: 1;
justify-content: flex-end;
input {
font-size: $fs12;
border: 1px solid $color-gray-30;
border-radius: $br-small;
width: 130px;
padding: $x-small;
margin: 0px;
}
}
}
.font-item {
margin-top: $big;
color: $color-gray-40;
font-size: $fs14;
background-color: $color-white;
display: flex;
min-width: 1000px;
width: 100%;
min-height: 97px;
align-items: center;
padding: $big;
justify-content: space-between;
&:not(:first-child) {
border-top: 1px solid $color-gray-10;
}
input {
border: 1px solid $color-gray-30;
border-radius: $br-small;
margin: 0px;
padding: $small;
font-size: $fs12;
}
> .family {
min-width: 200px;
width: 200px;
}
> .filenames {
min-width: 200px;
}
> .variants {
font-size: $fs14;
display: flex;
flex-wrap: wrap;
flex-grow: 1;
.variant {
display: flex;
justify-content: space-between;
align-items: center;
padding: 8px 12px;
cursor: pointer;
.icon {
display: flex;
height: 16px;
width: 16px;
margin-left: 6px;
align-items: center;
svg {
fill: transparent;
width: 12px;
height: 12px;
transform: rotate(45deg);
}
}
&:hover {
.icon svg {
fill: $color-gray-30;
}
}
}
}
.filenames {
display: flex;
flex-direction: column;
font-size: $fs12;
}
.options {
display: flex;
justify-content: flex-end;
.icon {
width: $big;
cursor: pointer;
display: flex;
margin-left: 10px;
justify-content: center;
align-items: center;
svg {
width: 16px;
height: 16px;
}
&.close {
svg {
transform: rotate(45deg);
}
}
}
}
}
.dashboard-fonts-upload {
max-width: 1000px;
width: 100%;
display: flex;
flex-direction: column;
.upload-button {
width: 100px;
}
}
.dashboard-fonts-hero {
font-size: $fs14;
padding: $x-big;
background-color: $color-white;
margin-top: $x-big;
display: flex;
justify-content: space-between;
.banner {
background-color: unset;
display: flex;
.icon {
display: flex;
align-items: center;
padding-left: 0px;
padding-right: 10px;
svg {
fill: $color-info;
}
}
}
.desc {
h2 {
margin-bottom: $medium;
color: $color-black;
}
width: 80%;
color: $color-gray-40;
}
}
.fonts-placeholder {
display: flex;
flex-direction: column;
justify-content: center;
align-items: center;
max-width: 1000px;
width: 100%;
height: 161px;
border: 1px dashed $color-gray-20;
margin-top: 16px;
.icon {
svg {
fill: $color-gray-40;
width: 32px;
height: 32px;
}
}
.label {
color: $color-gray-40;
font-size: $fs14;
}
}
}

7
frontend/resources/styles/main/partials/modal.scss
View file

@ -382,7 +382,7 @@
.modal-left {
align-items: center;
background-color: $color-primary;
background-color: $color-pink;
border-top-left-radius: 5px;
border-bottom-left-radius: 5px;
display: flex;
@ -391,6 +391,10 @@
overflow: hidden;
padding: $x-big;
width: 230px;
&.welcome {
padding: 0;
}
}
.modal-right {
@ -498,6 +502,7 @@
color: $color-black;
flex: 1;
flex-direction: column;
overflow: visible;
padding: $x-big 40px;
text-align: center;

7
frontend/resources/styles/main/partials/sidebar-assets.scss
View file

@ -164,6 +164,8 @@
.asset-title {
display: flex;
cursor: pointer;
font-size: $fs11;
text-transform: uppercase;
& .num-assets {
color: $color-gray-30;
@ -371,14 +373,11 @@
// overflow-y: scroll;
// }
.asset-list {
margin-top: $medium;
}
.asset-list-item {
display: flex;
align-items: center;
border: 1px solid transparent;
border-radius: $br-small;
margin-top: $x-small;
padding: 2px;
font-size: $fs12;

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