Merge branch 'staging' into main

.gitignore

@@ -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*

CHANGES.md

@@ -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

backend/deps.edn

@@ -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/data.json {:mvn/version "2.2.3"}
-  org.clojure/core.async {:mvn/version "1.3.610"}
+  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"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.2.659"}
-  metosin/reitit-ring {:mvn/version "0.5.12"}
+  metosin/reitit-ring {:mvn/version "0.5.13"}
-  metosin/jsonista {:mvn/version "0.3.1"}
+  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/datoteka {:mvn/version "2.0.0"}
-  funcool/promesa {:mvn/version "6.0.0"}
+  funcool/promesa {:mvn/version "6.0.1"}
-  funcool/cuerdas {:mvn/version "2020.03.26-3"}
+  funcool/cuerdas {:mvn/version "2021.05.09-0"}
 
-  buddy/buddy-core {:mvn/version "1.9.0"}
+  buddy/buddy-core {:mvn/version "1.10.1"}
-  buddy/buddy-hashers {:mvn/version "1.7.0"}
+  buddy/buddy-hashers {:mvn/version "1.8.1"}
-  buddy/buddy-sign {:mvn/version "3.3.0"}
+  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"}
+   {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
-    org.clojure/tools.namespace {:mvn/version "1.1.0"}
+    org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    org.clojure/test.check {:mvn/version "1.1.0"}
+    org.clojure/test.check {:mvn/version "RELEASE"}
 
     fipp/fipp {:mvn/version "0.6.23"}
     criterium/criterium {:mvn/version "0.4.6"}

backend/resources/log4j2-devenv.xml

@@ -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">
+    <Logger name="penpot" level="debug" additivity="false">
-      <AppenderRef ref="main" level="fatal" />
+      <AppenderRef ref="main" level="debug" />
+      <AppenderRef ref="zmq" level="debug" />
     </Logger>
 
     <Logger name="user" level="trace" additivity="false">

backend/scripts/repl

@@ -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)"

backend/src/app/config.clj

@@ -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")
+  (try
-       (merge defaults)
+    (->> (read-env "penpot")
-       (us/conform ::config)))
+         (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)

backend/src/app/db.clj

@@ -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]

backend/src/app/db/sql.clj

@@ -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))

backend/src/app/http/errors.clj

@@ -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}})))
 

backend/src/app/http/oauth.clj

@@ -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)]
+        (let [info (json/read-str (:body res) :key-fn keyword)]
-          (-> data
+          {:backend (:name provider)
-              (assoc :backend (:name provider))
+           :email (:email info)
-              (assoc :fullname name)))))
+           :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]
+  [{:keys [tokens] :as cfg} {:keys [params] :as request}]
-  (let [invitation (get-in request [:params :invitation-token])
+  (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"}
+              :scopes        (cf/get :oidc-scopes #{"openid" "profile"})
-                                   (cf/get :oidc-scopes #{}))
               :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"
+              :scopes        #{"openid" "email" "profile"}
-                               "https://www.googleapis.com/auth/userinfo.email"
-                               "https://www.googleapis.com/auth/userinfo.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"
+              :scopes        #{"read:user" "user:email"}
-                               "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"

backend/src/app/http/session.clj

@@ -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

backend/src/app/loggers/audit.clj

@@ -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))

backend/src/app/loggers/loki.clj

@@ -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))]
+    (let [input (a/chan (a/sliding-buffer 1024))]
-      (receiver :sub output)
+      (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]

backend/src/app/loggers/mattermost.clj

@@ -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"

backend/src/app/main.clj

@@ -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

backend/src/app/media.clj

@@ -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
+(defmethod process-error org.im4java.core.InfoException
-  [{:keys [cmd] :as params}]
+  [error]
-  (ex/raise :type :internal
+  (ex/raise :type :validation
-            :code :not-implemented
+            :code :invalid-image
-            :hint (str "No impl found for process cmd:" cmd)))
+            :cause error))
 
-(defn run
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  [{:keys [rlimits]} params]
+;; --- Fonts Generation
-  (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)))))
 
-;; --- Utility functions
+(def all-fotmats #{"font/woff2", "font/woff", "font/otf", "font/ttf"})
 
-(defn validate-media-type
+(defmethod process :generate-fonts
-  ([mtype] (validate-media-type mtype cm/valid-media-types))
+  [{:keys [input] :as params}]
-  ([mtype allowed]
+  (letfn [(ttf->otf [data]
-   (when-not (contains? allowed mtype)
+            (let [input-file  (fs/create-tempfile :prefix "penpot")
-     (ex/raise :type :validation
+                  output-file (fs/path (str input-file ".otf"))
-               :code :media-type-not-allowed
+                  _           (with-open [out (io/output-stream input-file)]
-               :hint "Seems like you are uploading an invalid media object"))))
+                                (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)))))))))

backend/src/app/migrations.clj

@@ -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")}
    ])
 
 

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

@@ -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;
+

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

@@ -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;

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

@@ -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;

backend/src/app/migrations/sql/0053-add-team-font-variant-table.sql

@@ -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;
+

backend/src/app/migrations/sql/0054-add-audit-log-table.sql

@@ -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;

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

@@ -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;

backend/src/app/msgbus.clj

@@ -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)

backend/src/app/rlimits.clj

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

backend/src/app/rpc.clj

@@ -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]
+  [{:keys [audit] :as cfg} f mdata]
-  (let [f     (wrap-with-rlimits cfg f mdata)
+  (let [f      (wrap-with-rlimits cfg f mdata)
-        f     (wrap-with-metrics cfg f mdata)
+        f      (wrap-with-metrics cfg f mdata)
-        spec  (or (::sv/spec mdata) (s/spec any?))]
+        spec   (or (::sv/spec mdata) (s/spec any?))
-    (l/trace :action "register"
+        auth?  (:auth mdata true)]
-             :name (::sv/name mdata))
+
+    (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]

backend/src/app/rpc/mutations/demo.clj

@@ -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
+      (with-meta {:email email
-       :password password})))
+                  :password password}
+        {::audit/profile-id id}))))

backend/src/app/rpc/mutations/files.clj

@@ -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
+  (let [changes (if changes-with-metadata
-                 (update :revn inc)
+                  (mapcat :changes changes-with-metadata)
-                 (update :data (fn [data]
+                  changes)
-                                 (-> data
+
-                                     (blob/decode)
+        file    (-> file
-                                     (assoc :id (:id file))
+                    (update :revn inc)
-                                     (pmg/migrate-data)
+                    (update :data (fn [data]
-                                     (cp/process-changes changes)
+                                    (-> data
-                                     (blob/encode)))))]
+                                        (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)
 

backend/src/app/rpc/mutations/fonts.clj

@@ -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))

backend/src/app/rpc/mutations/management.clj

@@ -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}]
+  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
-  (let [flibs    (db/exec! conn [sql:retrieve-used-libraries (:id file)])
+  (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
-        fmeds    (db/exec! conn [sql:retrieve-used-media-objects (: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))

backend/src/app/rpc/mutations/media.clj

@@ -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

backend/src/app/rpc/mutations/profile.clj

@@ -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))
+  (when-let [domains (cfg/get :registration-domain-whitelist)]
-    (ex/raise :type :validation
+    (when-not (email-domain-in-whitelist? domains (:email params))
-              :code :email-domain-is-not-allowed))
+      (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
+  "Returns true if email's domain is in the given whitelist or if
-  whitelist is an empty string."
+  given whitelist is an empty string."
-  [whitelist email]
+  [domains email]
-  (if (str/empty-or-nil? whitelist)
+  (if (or (empty? domains)
+          (nil? domains))
     true
-    (let [domains (str/split whitelist #",\s*")
+    (let [[_ candidate] (-> (str/lower email)
-          domain  (second (str/split email #"@" 2))]
+                            (str/split #"@" 2))]
-      (contains? (set domains) domain))))
+      (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]
+  [conn {:keys [id fullname email password is-active is-muted is-demo opts]
-         :or {is-active false is-muted false is-demo false}}]
+         :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}]
+  [{:keys [conn] :as cfg} {:keys [email] :as params}]
-  (letfn [(info->props [info]
+  (letfn [(info->lang [{:keys [locale] :as info}]
-            (dissoc info :name :fullname :email :backend))
-
-          (info->lang [{:keys [locale] :as info}]
             (when (and (string? locale)
                        (not (str/blank? locale)))
               locale))
 
-          (create-profile [conn {:keys [email] :as info}]
+          (create-profile [conn {:keys [fullname backend email props] :as info}]
-            (db/insert! conn :profile
+            (let [params {:id (uuid/next)
-                        {:id (uuid/next)
+                          :fullname fullname
-                         :fullname (:fullname info)
+                          :email (str/lower email)
-                         :email (str/lower email)
+                          :lang (info->lang props)
-                         :lang (info->lang info)
+                          :auth-backend backend
-                         :auth-backend backend
+                          :is-active true
-                         :is-active true
+                          :password "!"
-                         :password "!"
+                          :props (db/tjson props)
-                         :props (db/tjson (info->props info))
+                          :is-demo false}]
-                         :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)
+            (let [props (merge (:props profile)
-                                 (info->props info))]
+                               (: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})
 

backend/src/app/rpc/mutations/teams.clj

@@ -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]))
 

backend/src/app/rpc/queries/files.clj

@@ -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
+  (db/exec! pool [sql:search-files
-                                profile-id team-id
+                  profile-id team-id
-                                profile-id team-id
+                  profile-id team-id
-                                search-term])]
+                  search-term]))
-    (into [] decode-row-xf rows)))
 
 
-;; --- 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)]
+    (let [file    (retrieve-file conn file-id)
-      (get-in file [:data :pages-index 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
+  (let [libraries (->> (db/exec! conn [sql:file-libraries file-id])
-        (into [] decode-row-xf (db/exec! conn [sql:file-libraries is-indirect 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
+(sv/defmethod ::team-recent-files
-  "select fl.*
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
-     from file as fl
+  (with-open [conn (db/open pool)]
-    where fl.id = ?")
+    (teams/check-read-permissions! conn profile-id team-id)
-
+    (db/exec! conn [sql:team-recent-files team-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)))
 
 
 ;; --- Helpers

backend/src/app/rpc/queries/fonts.clj

@@ -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})))
+

backend/src/app/rpc/queries/recent_files.clj

@@ -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

backend/src/app/setup.clj

@@ -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}]
+  [{:keys [conn key] :as cfg}]
-  (let [key (-> (bn/random-bytes 64)
+  (if key
-                (bc/bytes->b64u)
+    (let [key (db/tjson key)]
-                (bc/bytes->str))]
+      (db/exec-one! conn [sql:upsert-secret-key key key]))
-    (db/insert! conn :server-prop
+    (let [key (-> (bn/random-bytes 64)
-                {:id "secret-key"
+                  (bc/bytes->b64u)
-                 :preload true
+                  (bc/bytes->str))
-                 :content (db/tjson key)}
+          key (db/tjson key)]
-                {:on-conflict-do-nothing true})))
+      (db/exec-one! conn [sql:insert-secret-key key]))))
 
 (defn- initialize-instance-id!
   [{:keys [conn] :as cfg}]

backend/src/app/setup/initial_data.clj

@@ -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))))))))
 

backend/src/app/storage/impl.clj

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

backend/src/app/tasks/delete_object.clj

@@ -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)))))

backend/src/app/tasks/file_media_gc.clj

@@ -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))

backend/src/app/tasks/telemetry.clj

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

backend/src/app/tokens.clj

@@ -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}]
+  [_ {:keys [props] :as cfg}]
-  (let [secret (derive-tokens-secret (:secret-key sprops))
+  (let [secret (derive-tokens-secret (:secret-key props))
         cfg    (assoc cfg ::secret secret)]
     (fn [action params]
       (case action

backend/src/app/util/async.clj

@@ -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))

backend/src/app/util/logging.clj

@@ -60,8 +60,8 @@
           ^Object msg)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async] :as props}]
+  [& {:keys [level cause ::logger ::async ::raw] :as props}]
-  (let [props      (dissoc props :level :cause ::logger ::async)
+  (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))))
+            `(send-off logging-agent
-            `(write-log! ~logger-sym ~level-sym ~cause (build-map-message ~props)))))))
+                       (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]

backend/tests/app/tests/test_common_geom_shapes.clj

@@ -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}

backend/tests/app/tests/test_common_pages_migrations.clj

@@ -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)))
+    ))

backend/tests/app/tests/test_services_files.clj

@@ -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)

backend/tests/app/tests/test_services_fonts.clj

@@ -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))))
+
+
+
+
+

backend/tests/app/tests/test_services_profile.clj

@@ -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"))))))

common/app/common/data.cljc

@@ -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) {}))
+  (reduce conj (or (first maps) {}) (rest maps)))
-         maps (next maps)]
-    (if (nil? maps)
-      (persistent! res)
-      (recur (reduce-kv assoc! res (first maps))
-             (next 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 {}))))

common/app/common/exceptions.cljc

@@ -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

common/app/common/geom/shapes.cljc

@@ -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)

common/app/common/geom/shapes/intersect.cljc

@@ -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)

common/app/common/geom/shapes/transforms.cljc

@@ -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)
+                    (merge rect-shape)))]
-                    (update :x #(mth/precision % 0))
-                    (update :y #(mth/precision % 0))
-                    (update :width #(mth/precision % 0))
-                    (update :height #(mth/precision % 0))))]
     (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]
+(defn apply-text-resize
-  (let [shape (apply-displacement shape)
+  [shape orig-shape modifiers]
-        center (gco/center-shape shape)
+  (if (and (= (:type shape) :text)
-        modifiers (:modifiers shape)]
+           (:resize-scale-text modifiers))
-    (if (and modifiers center)
+    (let [merge-attrs (fn [attrs]
-      (let [transform (modifiers->transform center modifiers)]
+                        (let [font-size (-> (get attrs :font-size 14)
-        (-> shape
+                                            (d/parse-double)
-            (set-flip modifiers)
+                                            (* (-> modifiers :resize-vector :x))
-            (apply-transform transform)
+                                            (str)
-            (dissoc :modifiers)))
+                                            )]
-      shape)))
+                          (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))))
 

common/app/common/media.cljc

@@ -9,10 +9,10 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
-(def valid-media-types
+(def valid-font-types #{"font/ttf" "font/woff", "font/otf"})
-  #{"image/jpeg", "image/png", "image/webp", "image/gif", "image/svg+xml"})
+(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-media-types (str/join "," valid-media-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"))

common/app/common/pages.cljc

@@ -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)

common/app/common/pages/common.cljc

@@ -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)
 

common/app/common/pages/helpers.cljc

@@ -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))))

common/app/common/pages/indices.cljc

@@ -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))))

common/app/common/pages/init.cljc

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

common/app/common/pages/migrations.cljc

@@ -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 %)))))
+

common/app/common/pages/spec.cljc

@@ -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?))

common/app/common/spec.cljc

@@ -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-.]+"
+(s/def ::email
-      cfn (fn [v]
+  (s/conformer
-            (if (string? v)
+   (fn [v]
-              (if-let [matches (re-seq re v)]
+     (if (string? v)
-                (first matches)
+       (if-let [matches (re-seq email-re v)]
-                (do ::s/invalid))
+         (first matches)
-              ::s/invalid))]
+         (do ::s/invalid))
-  (s/def ::email (s/conformer cfn str)))
+       ::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]
+(s/def ::set-of-str
-          (str/join "," s))]
+  (s/conformer
-  (s/def ::set-of-str (s/conformer conformer unformer)))
+   (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
 

common/app/common/uuid_impl.js

@@ -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);
+        global.crypto.getRandomValues(buf);
-        return buf;
-      };
-    } else if (typeof self === "object" && typeof self.crypto !== "undefined") {
-      return (buf) => {
-        self.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++) {

docker/devenv/Dockerfile

@@ -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
 

docker/devenv/docker-compose.yaml

@@ -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

docker/devenv/files/nginx.conf

@@ -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;

docker/images/files/config.js

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

docker/images/files/nginx-entrypoint.sh

@@ -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 "$@";

exporter/shadow-cljs.edn

@@ -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"]
+  [lambdaisland/uri "1.4.54"]
-  [com.cognitect/transit-cljs "0.8.269"]
+  [metosin/reitit-core "0.5.13"]]
-  [frankiesardo/linked "1.3.0"]]
 
  :source-paths ["src" "vendor" "../common"]
  :jvm-opts ["-Xmx512m" "-Xms50m" "-XX:+UseSerialGC"]

exporter/src/app/browser.cljs

@@ -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]
+   [promesa.core :as p]))
-   ["puppeteer-cluster" :as ppc]))
 
-(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!
+(defn set-cookie!
-  [page {:keys [viewport user-agent scale]
+  [page {:keys [key value domain]}]
-         :or {user-agent USER-AGENT
+  (.setCookie ^js page #js {:name key
-              scale 1}}]
+                            :value value
-  (let [[width height] viewport]
+                            :domain domain}))
-    (.emulate ^js page #js {:viewport #js {:width width
+
-                                           :height height
+(defn configure-page!
-                                           :deviceScaleFactor scale}
+  [page {:keys [timeout cookie user-agent viewport]}]
-                            :userAgent user-agent})))
+  (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!
+;; --- BROWSER STATE
-  ([] (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))))
 
-(defn stop!
+(def instance (atom nil))
-  [instance]
+
-  (p/do!
+(defn- create-browser
-   (.idle ^js instance)
+  [concurrency strategy]
-   (.close ^js instance)
+  (let [strategy (case strategy
-   (log/info :msg "shutdown headless browser")
+                   :browser (.-CONCURRENCY_BROWSER ^js ppc/Cluster)
-   nil))
+                   :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)))

exporter/src/app/config.cljs

@@ -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
+(def defaults
-  [s]
+  {:public-uri "http://localhost:3449"
-  (-> (str/kebab s)
+   :http-server-port 6061
-      (str/keyword)))
+   :browser-concurrency 5
+   :browser-strategy :incognito})
 
-(defonce env
+(s/def ::public-uri ::us/string)
-  (let [env (unchecked-get process "env")]
+(s/def ::http-server-port ::us/integer)
-    (persistent!
+(s/def ::browser-concurrency ::us/integer)
-     (reduce #(assoc! %1 (keywordize %2) (unchecked-get env %2))
+(s/def ::browser-strategy ::us/keyword)
-             (transient {})
-             (js/Object.keys env)))))
 
-(defonce config
+(s/def ::config
-  {:public-uri (:penpot-public-uri env "http://localhost:3449")})
+  (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)))

exporter/src/app/core.cljs

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

exporter/src/app/http.cljs

@@ -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!
+(def instance (atom nil))
-  [extra]
+
-  (log/info :msg "starting http server" :port 6061)
+(defn init
+  []
   (let [router  (r/router routes)
-        handler (impl/handler router extra)
+        handler (impl/handler router)
-        server  (impl/server handler)]
+        server  (impl/server handler)
-    (.listen server 6061)
+        port    (cf/get :http-server-port 6061)]
-    (p/resolved server)))
+    (.listen server port)
+    (log/info :msg "starting http server" :port port)
+    (reset! instance server)))
 
-(defn stop!
+(defn stop
-  [server]
+  []
-  (p/create (fn [resolve]
+  (if-let [server @instance]
-              (.close server (fn []
+    (p/create (fn [resolve]
-                               (log/info :msg "shutdown http server")
+                (.close server (fn []
-                               (resolve))))))
+                                 (log/info :msg "shutdown http server")
+                                 (resolve)))))
+    (p/resolved nil)))

exporter/src/app/http/export.cljs

@@ -6,15 +6,15 @@
 
 (ns app.http.export
   (:require
-   [app.http.export-bitmap :as bitmap]
+   [app.common.exceptions :as exc :include-macros true]
-   [app.http.export-svg :as svg]
+   [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]
+   [promesa.core :as p]))
-   [app.common.exceptions :as exc :include-macros true]
-   [app.common.spec :as us]))
 
 (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)
+      0 (exc/raise :type :validation
-      1 (handle-single-export
+                   :code :missing-exports)
-         request
+
-         (assoc (first exports)
+      1 (-> (first exports)
-                :name name
+            (assoc :name name)
-                :token token
+            (assoc :token token)
-                :file-id file-id
+            (assoc :file-id file-id)
-                :page-id page-id
+            (assoc :page-id page-id)
-                :object-id object-id))
+            (assoc :object-id object-id)
-      (handle-multiple-export
+            (handle-single-export))
-       request
+
-       (map (fn [item]
+      (->> exports
-              (assoc item
+           (map (fn [item]
-                     :name name
+                  (-> item
-                     :token token
+                      (assoc :name name)
-                     :file-id file-id
+                      (assoc :token token)
-                     :page-id page-id
+                      (assoc :file-id file-id)
-                     :object-id object-id)) exports)))))
+                      (assoc :page-id page-id)
+                      (assoc :object-id object-id))))
+           (handle-multiple-export)))))
 
 (defn- handle-single-export
-  [{:keys [browser]} params]
+  [params]
-  (p/let [result (perform-export browser 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)
+    :png  (rb/render params)
-    :jpeg (bitmap/export browser params)
+    :jpeg (rb/render params)
-    :svg  (svg/export browser params)))
+    :svg  (rs/render params)))
 
 (defn- find-filename-candidate
   [params used]

exporter/src/app/http/export_bitmap.cljs

@@ -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")}))
-

exporter/src/app/http/impl.cljs

@@ -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])
+   [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 {}))))
 
 (defn- match
   [router ctx]
-  (let [uri (.parse Uri (unchecked-get ctx "originalUrl"))]
+  (let [uri (u/uri (unchecked-get ctx "originalUrl"))]
-    (when-let [match (r/match-by-path router (.getPath ^js uri))]
+    (when-let [match (r/match-by-path router (:path uri))]
-      (assoc match :query-params (query-params 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
+         :headers {"x-error" (t/encode data)}
-                                           :message (ex-message error)})}
          :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
+            request {:method (str/lower (unchecked-get ctx "method"))
-                           :method (str/lower (unchecked-get ctx "method"))
+                     :body body
-                           :body body
+                     :ctx ctx
-                           :ctx ctx
+                     :headers headers
-                           :headers headers
+                     :cookies cookies}]
-                           :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 [_]

exporter/src/app/http/thumbnail.cljs

@@ -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)}})))

exporter/src/app/renderer/bitmap.cljs

@@ -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")})))
+

exporter/src/app/renderer/svg.cljs

@@ -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])
+   [lambdaisland.uri :as u]
-  (:import
+   [app.renderer.bitmap :refer [create-cookie]]
-   goog.Uri))
+   [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)
+            (p/let [attrs (bw/eval! node extract-element-attrs)
-                    shot  (bwr/screenshot node {:omit-background? true :type "png"})]
+                    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")
+            (p/let [dom     (bw/select page "#screenshot")
-                    xmldata (bwr/eval! dom (fn [elem] (.-outerHTML ^js elem)))
+                    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!
+            (let [viewport {:width 1920
-             (bwr/emulate! page {:viewport [1920 1080]
+                            :height 1080
-                                 :scale 4})
+                            :scale 4}
-             (bwr/set-cookie! page cookie)
+                  options  {:viewport viewport
-             (bwr/navigate! page uri)
+                            :timeout 15000
-             ;; (bwr/wait-for page "#screenshot foreignObject" {:visible true})
+                            :cookie cookie}]
-             (bwr/sleep page 2000)
+              (p/do!
-             ;; (bwr/eval! page (js* "() => document.body.style.background = 'transparent'"))
+               (bw/configure-page! page options)
-             page))
+               (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)
+    (let [path   (str "/render-object/" file-id "/" page-id "/" object-id)
-          uri  (doto (Uri. (:public-uri cfg/config))
+          uri    (-> (u/uri (cf/get :public-uri))
-                 (.setPath "/")
+                     (assoc :path "/")
-                 (.setFragment path))
+                     (assoc :fragment path))
-          rctx {:cookie {:domain (str (.getDomain uri) ":" (.getPort uri))
+          cookie (create-cookie uri token)
-                         :key "auth-token"
+          rctx   {:cookie cookie
-                         :value token}
+                  :uri (str uri)}]
-                :uri (.toString uri)}]
+      (log/info :uri (:uri rctx))
-
+      (bw/exec! browser (partial handle rctx)))))
-      (log/info :uri (.toString uri))
-      (bwr/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
+(defn render
-  [browser params]
+  [params]
-  (us/assert ::export-params params)
+  (us/assert ::render-params params)
-  (p/let [content (render-object browser params)]
+  (let [browser @bw/instance]
-    {:content content
+    (when-not browser
-     :filename (or (:filename params)
+      (ex/raise :type :internal
-                   (str (:name params)
+                :code :browser-not-ready
-                        (:suffix params "")
+                :hint "browser cluster is not initialized yet"))
-                        ".svg"))
+
-     :length (alength content)
+
-     :mime-type "image/svg+xml"}))
+    (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"})))

exporter/src/app/util/transit.cljs

@@ -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)))

exporter/yarn.lock

@@ -11,9 +11,9 @@
     regenerator-runtime "^0.13.4"
 
 "@types/node@*":
-  version "15.0.1"
+  version "15.0.2"
-  resolved "https://registry.yarnpkg.com/@types/node/-/node-15.0.1.tgz#ef34dea0881028d11398be5bf4e856743e3dc35a"
+  resolved "https://registry.yarnpkg.com/@types/node/-/node-15.0.2.tgz#51e9c0920d1b45936ea04341aa3e2e58d339fb67"
-  integrity sha512-TMkXt0Ck1y0KKsGr9gJtWGjttxlZnnvDtphxUOSd0bfaR6Q1jle+sPvrzNR1urqYTWMinoKvjKfXUGsumaO1PA==
+  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"
+  version "3.12.1"
-  resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.11.2.tgz#10e3b35788c00f431bc0d601d7551475ec3e792c"
+  resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.12.1.tgz#934da8b9b7221e2a2443dc71dfa5bd77a7ea00b8"
-  integrity sha512-DQxdEKm+zFsnON7ZGOgUAQXBt1UJJ01tOzN/HgQ7cNf0oEHW1tcBLfCQQd1q6otdLu5gAdvKYxKHAoXGwE/kiQ==
+  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"
+  version "7.1.7"
-  resolved "https://registry.yarnpkg.com/glob/-/glob-7.1.6.tgz#141f33b81a7c2492e125594307480c46679278a6"
+  resolved "https://registry.yarnpkg.com/glob/-/glob-7.1.7.tgz#3b193e9233f01d42d0b3f78294bbeeb418f94a90"
-  integrity sha512-LwaxwyZ72Lk7vZINtNNrywX0ZuLyStrdDtabefZKAY5ZGJhVtgdznluResxNmPitE0SAO+O26sWTHeKSI2wMBA==
+  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"
+  version "1.0.9"
-  resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.8.tgz#dfb5c2b120e02b0a8d9d2c6806cd5621aa922f7b"
+  resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.9.tgz#e5f82c2323673e7fcad3d12858c83c4039f6399c"
-  integrity sha512-2Omr/twNtufVZFr1GhxjOMFPAj2sjc/dKaIqBhvo4qciXfJmITGH6ZGd8eZYNHza8t1y0e01AuqRhJwfWp26WQ==
+  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"
+  version "9.1.1"
-  resolved "https://registry.yarnpkg.com/puppeteer/-/puppeteer-9.1.0.tgz#0530ed1f595088eefd078c8f1f7618d00f216a56"
+  resolved "https://registry.yarnpkg.com/puppeteer/-/puppeteer-9.1.1.tgz#f74b7facf86887efd6c6b9fabb7baae6fdce012c"
-  integrity sha512-+BWwEKYQ9oBTUcDYwfgnVPlHSEYqD4sXsMqQf70vSlTE6YIuXujc7zKgO3FyZNJYVrdrUppy/LLwGF1IRacQMQ==
+  integrity sha512-W+nOulP2tYd/ZG99WuZC/I5ljjQQ7EUw/jQGcIb9eu8mDlZxNY2SgcJXTLG9h5gRvqA3uJOe4hZXYsd3EqioMw==
   dependencies:
     debug "^4.1.0"
     devtools-protocol "0.0.869402"

frontend/dev/cljs/user.cljs

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

frontend/gulpfile.js

@@ -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;
+      const isMarkdown = l.includes(comments.flag, "markdown");
-      if (msgstr.length === 1) {
+
-        result[key][lang] = msgstr[0];
+      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});
+      // }
     }
   }
 

frontend/package.json

@@ -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"
   }
 }

frontend/resources/styles/common/dependencies/colors.scss

@@ -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;

frontend/resources/styles/main-default.scss

@@ -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";

frontend/resources/styles/main/partials/dashboard-fonts.scss

@@ -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;
+    }
+  }
+}

frontend/resources/styles/main/partials/modal.scss

@@ -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;
 

frontend/resources/styles/main/partials/sidebar-assets.scss

@@ -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;