📎 Update version.txt file.

Among other related that need to be ported.

.circleci/config.yml

@@ -36,17 +36,23 @@ jobs:
       - run:
           name: common lint
           working_directory: "./common"
-          command: "clj-kondo --parallel --lint src/"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
 
       - run:
           name: frontend lint
           working_directory: "./frontend"
-          command: "clj-kondo --parallel --lint src/"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
 
       - run:
           name: backend lint
           working_directory: "./backend"
-          command: "clj-kondo --parallel --lint src/"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
 
       # run backend test
       - run:

.clj-kondo/config.edn

@@ -3,7 +3,8 @@
   rumext.alpha/defc clojure.core/defn
   rumext.alpha/fnc clojure.core/fn
   app.common.data/export clojure.core/def
-  app.db/with-atomic clojure.core/with-open}
+  app.db/with-atomic clojure.core/with-open
+  app.common.logging/with-context clojure.core/do}
 
  :hooks
  {:analyze-call

.clj-kondo/hooks/export.clj

@@ -51,18 +51,26 @@
 
 (defn service-defmethod
   [{:keys [:node]}]
-  (let [[rnode rtype & other] (:children node)
+  (let [[rnode rtype ?meta & other] (:children node)
         rsym    (gensym (name (:k rtype)))
         result  (api/list-node
                  [(api/token-node (symbol "do"))
                   (api/list-node
                    [(api/token-node (symbol "declare"))
                     (api/token-node rsym)])
+                  (if (= :map (:tag ?meta))
+                    (api/list-node
+                     [(api/token-node (symbol "reset-meta!"))
+                      (api/token-node rsym)
+                      ?meta])
+                    (api/list-node
+                     [(api/token-node (symbol "comment"))
+                      (api/token-node rsym)]))
                   (api/list-node
                    (into [(api/token-node (symbol "defmethod"))
                           (api/token-node rsym)
                           rtype]
-                         other))])]
+                         (cons ?meta other)))])]
+    ;; (prn "==============" rtype (into {} ?meta))
+    ;; (prn (api/sexpr result))
     {:node result}))
-
-

CHANGES.md

@@ -1,6 +1,5 @@
 # CHANGELOG
 
-
 ## :rocket: Next
 
 ### :boom: Breaking changes
@@ -10,6 +9,103 @@
 ### :heart: Community contributions by (Thank you!)
 
 
+# 1.10.4-beta
+
+### :sparkles: Enhacements
+
+- Allow parametrice file snapshoting interval.
+
+### :bug: Bugs fixed
+
+- Fix issue on :mov-object change impl.
+- Minor fix on how file changes log is persisted.
+- Fix many issues on error reporting.
+
+
+# 1.10.3-beta
+
+### :sparkles: Enhacements
+
+- Make all logging asynchronous, this avoid some overhead on jetty threads at cost of logging latency.
+- Increase default session time to 15 days.
+
+### :bug: Bugs fixed
+
+- Fix unexpected exception on saving pages with default grids [#2409](https://tree.taiga.io/project/penpot/issue/2409)
+- Fix react warnings on setting size 1 on row and column grids.
+- Fix minor issues on ZMQ logging listener (used in error reporting service).
+- Remove "ALPHA" from the code.
+- Fix value and nil handling on numeric-input component. This fixes many issues related to typography, components, etc. renaming.
+- Fix NPE on email complains processing.
+- Fix white page after leaving a team.
+- Fix missing leave team button outside members page.
+
+### :arrow_up: Deps updates
+
+- Update log4j2 dependency.
+
+
+# 1.10.2-beta
+
+### :bug: Bugs fixed
+
+- Fix corner case issues with media file uploads.
+- Fix issue with default page grids validation.
+- Fix issue related to some raceconditions on workspace navigation events.
+
+### :arrow_up: Deps updates
+
+- Update log4j2 dependency.
+
+
+# 1.10.1-beta
+
+### :bug: Bugs fixed
+
+- Fix problems with team management [#1353](https://github.com/penpot/penpot/issues/1353)
+
+
+## 1.10.0-beta
+
+### :boom: Breaking changes
+
+- The initial project / data mechanism (not documented) has been
+  disabled. Is the mechanism used for creating initial project on user
+  signup. With the new onboarding approach, this subsystem is no
+  longer needed and is disabled.
+
+### :sparkles: New features
+
+- Enhance corner radius behavior [Taiga #2190](https://tree.taiga.io/project/penpot/issue/2190).
+- Allow preserve scroll position in interactions [Taiga #2250](https://tree.taiga.io/project/penpot/us/2250).
+- Add new onboarding modals.
+
+### :bug: Bugs fixed
+
+- Fix problem with exporting before the document is saved [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189).
+- Fix undo stacking when changing color from color-picker [Taiga #2191](https://tree.taiga.io/project/penpot/issue/2191).
+- Fix pages dropdown in viewer [Taiga #2087](https://tree.taiga.io/project/penpot/issue/2087).
+- Fix problem when exporting texts with gradients or opacity [Taiga #2200](https://tree.taiga.io/project/penpot/issue/2200).
+- Fix problem with view mode comments [Taiga #2226](https://tree.taiga.io/project/penpot/issue/2226).
+- Disallow to create a component when already has one [Taiga #2237](https://tree.taiga.io/project/penpot/issue/2237).
+- Add ellipsis in long labels for input fields [Taiga #2224](https://tree.taiga.io/project/penpot/issue/2224)
+- Fix problem with text rendering on export [Taiga #2223](https://tree.taiga.io/project/penpot/issue/2223)
+- Fix problem when flattening booleans losing styles [Taiga #2217](https://tree.taiga.io/project/penpot/issue/2217)
+- Add shortcuts to boolean icons popups [Taiga #2220](https://tree.taiga.io/project/penpot/issue/2220)
+- Fix a worker error when transforming a rectangle into path
+- Fix max/min values for opacity fields [Taiga #2183](https://tree.taiga.io/project/penpot/issue/2183)
+- Fix viewer comment position when zoom applied [Taiga #2240](https://tree.taiga.io/project/penpot/issue/2240)
+- Remove change style on hover for options [Taiga #2172](https://tree.taiga.io/project/penpot/issue/2172)
+- Fix problem in viewer with dropdowns when comments active [#1303](https://github.com/penpot/penpot/issues/1303)
+- Add placeholder to create shareable link
+- Fix project files count not refreshing correctly after import [Taiga #2216](https://tree.taiga.io/project/penpot/issue/2216)
+- Remove button after import process finish [Taiga #2215](https://tree.taiga.io/project/penpot/issue/2215)
+
+### :heart: Community contributions by (Thank you!)
+
+- To the translation community for the hard work on making penpot
+  available on so many languages.
+
 ## 1.9.0-alpha
 
 ### :boom: Breaking changes

backend/deps.edn

@@ -1,12 +1,6 @@
-{
- ;; :mvn/repos
- ;; {"central" {:url "https://repo1.maven.org/maven2/"}
- ;;  "clojars" {:url "https://clojars.org/repo"}
- ;;  "jcenter" {:url "https://jcenter.bintray.com/"}
- ;;  }
- :deps
- {penpot/common
-  {:local/root "../common"}
+{:deps
+ {penpot/common {:local/root "../common"}
+  org.clojure/core.async {:mvn/version "1.5.648"}
 
   ;; Logging
   org.zeromq/jeromq {:mvn/version "0.5.2"}
@@ -32,7 +26,6 @@
   metosin/reitit-ring {:mvn/version "0.5.15"}
   org.postgresql/postgresql {:mvn/version "42.2.23"}
   com.zaxxer/HikariCP {:mvn/version "5.0.0"}
-
   funcool/datoteka {:mvn/version "2.0.0"}
 
   buddy/buddy-core {:mvn/version "1.10.1"}
@@ -49,9 +42,7 @@
   io.sentry/sentry {:mvn/version "5.1.2"}
 
   ;; Pretty Print specs
-  fipp/fipp {:mvn/version "0.6.24"}
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-
   software.amazon.awssdk/s3 {:mvn/version "2.17.40"}}
 
  :paths ["src" "resources"]
@@ -68,10 +59,6 @@
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
-  :fn-fixtures
-  {:exec-fn app.cli.fixtures/run
-   :args {}}
-
   :kaocha
   {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.887"}}
    :main-opts ["-m" "kaocha.runner"]}

backend/dev/user.clj

@@ -95,3 +95,10 @@
    [{:v1 (alength (blob/encode data {:version 1}))
      :v2 (alength (blob/encode data {:version 2}))
      :v3 (alength (blob/encode data {:version 3}))}]))
+
+
+(defonce debug-tap
+  (do
+    (add-tap #(locking debug-tap
+                (prn "tap debug:" %)))
+    1))

backend/resources/emails/feedback/en.subj

@@ -1 +1 @@
-[PENPOT FEEDBACK]: {{subject|abbreviate:19}} (from {{email}})
+[PENPOT FEEDBACK]: {{subject}}

backend/resources/error-list.tmpl

@@ -0,0 +1,94 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta name="robots" content="noindex,nofollow">
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>penpot - error report {{id}}</title>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
+    <style>
+      * {
+        font-family: "JetBrains Mono", monospace; 
+        font-size: 12px;
+      }
+
+      body {
+        margin: 0px;
+        padding: 0px;
+      }
+      
+      h1 {
+        padding: 0px;
+        margin: 0px;
+        font-size: 14px;
+      }
+
+      main {
+        margin: 20px;
+        margin-top: 40px;
+      }
+
+      nav {
+        position: fixed;
+        width: 100vw;
+        top: 0;
+        left: 0;
+        padding: 5px 20px;
+        display: flex;
+        background: #e3e3e3;
+      }
+
+      nav > div {
+        text-transform: uppercase;
+        font-weight: bold;
+      }
+
+      ul {
+        display: flex;
+        margin: 0px;
+        padding: 0px;
+        flex-direction: column;
+        flex-wrap: wrap;
+        height: calc(100vh - 75px);
+        justify-content: flex-start;
+      }
+
+      li {
+        list-style: none;
+        padding: 0px;
+        margin: 0px;
+        line-height: 18px;
+        min-width: 210px;
+        margin: 0px 20px;
+        cursor: pointer;
+        display: flex;
+        justify-content: center;
+        border-radius: 3px;
+      }
+
+      li:hover {
+        background-color: #e9e9e9;
+      }
+
+      li > a {
+        text-decoration: none;
+        color: inherit;
+      }
+
+    </style>
+  </head>
+  <body>
+
+    <nav>
+      <h1>Latest error reports:</h1>
+    </nav>
+    <main>
+      <ul>
+        {% for item in items %}
+          <li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
+        {% endfor %}
+      </ul>
+    </main>
+  </body>
+</html>
+

backend/resources/error-report.tmpl

@@ -13,15 +13,40 @@
       }
       pre {
         margin: 0px;
+        line-height: 17px;
       }
+
+      main {
+        margin: 20px;
+      }
+
+      nav {
+        position: fixed;
+        width: 100vw;
+        top: 0;
+        left: 0;
+        padding: 5px 20px;
+        display: flex;
+        background: #e3e3e3;
+      }
+
+      nav > div {
+        text-transform: uppercase;
+        font-weight: bold;
+      }
+
+      nav > div:not(:last-child) {
+        margin-right: 10px;
+      }
+
       * {
         font-family: "JetBrains Mono", monospace; 
         font-size: 12px;
       }
       .table {
+        margin-top: 25px;
         display: flex;
         flex-direction: column;
-        margin: 10px;
       }
 
       .table-row {
@@ -34,6 +59,9 @@
         font-weight: 600;
         width: 60px;
         padding: 4px;
+
+        padding-top: 40px;
+        margin-top: -40px;
       }
 
       .table-val {
@@ -57,139 +85,70 @@
     </style>
   </head>
   <body>
-    <div class="table">
-      <div class="table-row">
-        <div class="table-key" title="Error ID">ERID: </div>
-        <div class="table-val">{{id}}</div>
-      </div>
-      {% if profile-id %}
-      <div class="table-row">
-        <div class="table-key" title="Profile ID">PFID: </div>
-        <div class="table-val">{{profile-id}}</div>
-      </div>
-      {% endif %}
 
-      {% if user-agent %}
-      <div class="table-row">
-        <div class="table-key">UAGT: </div>
-        <div class="table-val">{{user-agent}}</div>
-      </div>
-      {% endif %}
-
-      {% if frontend-version %}
-      <div class="table-row">
-        <div class="table-key">FVER: </div>
-        <div class="table-val">{{frontend-version}}</div>
-      </div>
-      {% endif %}
-
-      <div class="table-row">
-        <div class="table-key">BVER: </div>
-        <div class="table-val">{{version}}</div>
-      </div>
-
-      {% if host %}
-      <div class="table-row">
-        <div class="table-key">HOST: </div>
-        <div class="table-val">{{host}}</div>
-      </div>
-      {% endif %}
-
-      {% if tenant %}
-      <div class="table-row">
-        <div class="table-key">ENV: </div>
-        <div class="table-val">{{tenant}}</div>
-      </div>
-      {% endif %}
-
-      {% if public-uri %}
-      <div class="table-row">
-        <div class="table-key">PURI: </div>
-        <div class="table-val">{{public-uri}}</div>
-      </div>
-      {% endif %}
-
-      {% if type %}
-      <div class="table-row">
-        <div class="table-key">TYPE: </div>
-        <div class="table-val">{{type}}</div>
-      </div>
-      {% endif %}
-
-      {% if code %}
-      <div class="table-row">
-        <div class="table-key">CODE: </div>
-        <div class="table-val">{{code}}</div>
-      </div>
-      {% endif %}
-
-      {% if error %}
-      <div class="table-row">
-        <div class="table-key">CLSS: </div>
-        <div class="table-val">{{error.class}}</div>
-      </div>
-      {% endif %}
-
-      {% if error %}
-      <div class="table-row">
-        <div class="table-key">HINT: </div>
-        <div class="table-val">{{error.message}}</div>
-      </div>
-      {% endif %}
-
-      {% if method %}
-      <div class="table-row">
-        <div class="table-key">PATH: </div>
-        <div class="table-val">{{method|upper}} {{path}}</div>
-      </div>
-      {% endif %}
-
-      {% if explain %}
-        <div>(<a href="#explain">go to explain</a>)</div>
-      {% endif %}
-      {% if data %}
-        <div>(<a href="#edata">go to edata</a>)</div>
-      {% endif %}
-      {% if error %}
-        <div>(<a href="#trace">go to trace</a>)</div>
-      {% endif %}
-
-      {% if params %}
-      <div id="params" class="table-row multiline">
-        <div class="table-key">PARAMS: </div>
-        <div class="table-val">
-          <pre>{{params}}</pre>
-        </div>
-      </div>
-      {% endif %}
-
-      {% if explain %}
-      <div id="explain" class="table-row multiline">
-        <div class="table-key">EXPLAIN: </div>
-        <div class="table-val">
-          <pre>{{explain}}</pre>
-        </div>
-      </div>
+    <nav>
+      
+      <div>[<a href="/dbg/error"><<</a>]</div>
+      <div>[<a href="#context">context</a>]</div>
+      <div>[<a href="#params">params</a>]</div>
+      {% if spec-problems %}
+      <div>[<a href="#edata">spec</a>]</div>
       {% endif %}
 
       {% if data %}
-      <div id="edata" class="table-row multiline">
-        <div class="table-key">EDATA: </div>
-        <div class="table-val">
-          <pre>{{data}}</pre>
-        </div>
-      </div>
+      <div>[<a href="#edata">data</a>]</div>
       {% endif %}
+      {% if trace %}
+      <div>[<a href="#trace">trace</a>]</div>
+      {% endif %}
+    </nav>
+    <main>
+      <div class="table">
+        <div class="table-row multiline">
+          <div id="context" class="table-key">CONTEXT: </div>
+          <div class="table-val">
+            <pre>{{context}}</pre>
+          </div>
+        </div>
 
-      {% if error %}
-      <div id="trace" class="table-row multiline">
-        <div class="table-key">TRACE:</div>
-        <div class="table-val">
-          <pre>{{error.trace}}</pre>
+        {% if params %}
+        <div class="table-row multiline">
+          <div id="params" class="table-key">PARAMS: </div>
+          <div class="table-val">
+            <pre>{{params}}</pre>
+          </div>
         </div>
+        {% endif %}
+
+        <!-- NOTE: this is legacy, for old error data saved on the database -->
+        {% if data %}
+        <div class="table-row multiline">
+          <div id="edata" class="table-key">ERROR DATA: </div>
+          <div class="table-val">
+            <pre>{{data}}</pre>
+          </div>
+        </div>
+        {% endif %}
+
+        {% if spec-problems %}
+        <div class="table-row multiline">
+          <div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
+          <div class="table-val">
+            <pre>{{spec-problems}}</pre>
+          </div>
+        </div>
+        {% endif %}
+
+        {% if trace %}
+        <div class="table-row multiline">
+          <div id="trace" class="table-key">TRACE:</div>
+          <div class="table-val">
+            <pre>{{trace}}</pre>
+          </div>
+        </div>
+        {% endif %}
       </div>
-      {% endif %}
-    </div>
+    </main>
   </body>
 </html>
 

backend/resources/log4j2-devenv.xml

@@ -2,7 +2,7 @@
 <Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
     </Console>
 
     <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">

backend/scripts/repl

@@ -2,7 +2,16 @@
 
 export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
-export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Dlog4j2.configurationFile=log4j2-devenv.xml -J-Djdk.attach.allowAttachSelf -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
+
+export OPTIONS="
+       -A:jmx-remote:dev \
+       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory \
+       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
+       -J-XX:+UseShenandoahGC \
+       -J-XX:-OmitStackTraceInFastThrow \
+       -J-Xms50m -J-Xmx512m";
+
 # export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
 # export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
 

backend/scripts/start-dev

@@ -1,15 +1,9 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
-export PENPOT_ASSERTS_ENABLED=true
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-asserts"
 
 set -ex
 
-if [ ! -e ~/.fixtures-loaded ]; then
-    echo "Loading fixtures..."
-    clojure -Adev -X:fn-fixtures
-    touch ~/.fixtures-loaded
-fi
-
 if [ "$1" = "--watch" ]; then
     echo "Start Watch..."
 
@@ -27,6 +21,3 @@ if [ "$1" = "--watch" ]; then
 else
     clojure -A:dev -M -m app.main
 fi
-
-
-

backend/src/app/cli/fixtures.clj

@@ -1,258 +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.cli.fixtures
-  "A initial fixtures."
-  (:require
-   [app.common.logging :as l]
-   [app.common.pages :as cp]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.main :as main]
-   [app.rpc.mutations.profile :as profile]
-   [app.util.blob :as blob]
-   [buddy.hashers :as hashers]
-   [integrant.core :as ig]))
-
-(defn- mk-uuid
-  [prefix & args]
-  (uuid/namespaced uuid/zero (apply str prefix (interpose "-" args))))
-
-;; --- Profiles creation
-
-(def password (hashers/derive "123123"))
-
-(def preset-small
-  {:num-teams 5
-   :num-profiles 5
-   :num-profiles-per-team 5
-   :num-projects-per-team 5
-   :num-files-per-project 5
-   :num-draft-files-per-profile 10})
-
-(defn- rng-ids
-  [rng n max]
-  (let [stream (->> (.longs rng 0 max)
-                    (.iterator)
-                    (iterator-seq))]
-    (reduce (fn [acc item]
-              (if (= (count acc) n)
-                (reduced acc)
-                (conj acc item)))
-            #{}
-            stream)))
-
-(defn- rng-vec
-  [rng vdata n]
-  (let [ids (rng-ids rng n (count vdata))]
-    (mapv #(nth vdata %) ids)))
-
-(defn- rng-nth
-  [rng vdata]
-  (let [stream (->> (.longs rng 0 (count vdata))
-                    (.iterator)
-                    (iterator-seq))]
-    (nth vdata (first stream))))
-
-(defn- collect
-  [f items]
-  (reduce #(conj %1 (f %2)) [] items))
-
-(defn- register-profile
-  [conn params]
-  (->> (#'profile/create-profile conn params)
-       (#'profile/create-profile-relations conn)))
-
-(defn impl-run
-  [pool opts]
-  (let [rng (java.util.Random. 1)]
-    (letfn [(create-profile [conn index]
-              (let [id   (mk-uuid "profile" index)
-                    _    (l/info :action "create profile"
-                                 :index index
-                                 :id id)
-
-                    prof (register-profile conn
-                                           {:id id
-                                            :fullname (str "Profile " index)
-                                            :password "123123"
-                                            :is-demo true
-                                            :email (str "profile" index "@example.com")})
-                    team-id  (:default-team-id prof)
-                    owner-id id]
-                (let [project-ids (collect (partial create-project conn team-id owner-id)
-                                           (range (:num-projects-per-team opts)))]
-                  (run! (partial create-files conn owner-id) project-ids))
-                prof))
-
-            (create-profiles [conn]
-              (l/info :action "create profiles")
-              (collect (partial create-profile conn)
-                       (range (:num-profiles opts))))
-
-            (create-team [conn index]
-              (let [id (mk-uuid "team" index)
-                    name (str "Team" index)]
-                (l/info :action "create team"
-                        :index index
-                        :id id)
-                (db/insert! conn :team {:id id
-                                        :name name})
-                id))
-
-            (create-teams [conn]
-              (l/info :action "create teams")
-              (collect (partial create-team conn)
-                       (range (:num-teams opts))))
-
-            (create-file [conn owner-id project-id index]
-              (let [id (mk-uuid "file" project-id index)
-                    name (str "file" index)
-                    data (cp/make-file-data id)]
-                (l/info :action "create file"
-                        :index index
-                        :id id)
-                (db/insert! conn :file
-                            {:id id
-                             :data (blob/encode data)
-                             :project-id project-id
-                             :name name})
-                (db/insert! conn :file-profile-rel
-                            {:file-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-files [conn owner-id project-id]
-              (l/info :action "create files")
-              (run! (partial create-file conn owner-id project-id)
-                    (range (:num-files-per-project opts))))
-
-            (create-project [conn team-id owner-id index]
-              (let [id        (if index
-                                (mk-uuid "project" team-id index)
-                                (mk-uuid "project" team-id))
-                    name      (if index
-                                (str "project " index)
-                                "Drafts")
-                    is-default (nil? index)]
-                (l/info :action "create project"
-                        :index index
-                        :id id)
-                (db/insert! conn :project
-                            {:id id
-                             :team-id team-id
-                             :is-default is-default
-                             :name name})
-                (db/insert! conn :project-profile-rel
-                            {:project-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-projects [conn team-id profile-ids]
-              (l/info :action "create projects")
-              (let [owner-id (rng-nth rng profile-ids)
-                    project-ids (conj
-                                  (collect (partial create-project conn team-id owner-id)
-                                         (range (:num-projects-per-team opts)))
-                                  (create-project conn team-id owner-id nil))]
-                (run! (partial create-files conn owner-id) project-ids)))
-
-            (assign-profile-to-team [conn team-id owner? profile-id]
-              (db/insert! conn :team-profile-rel
-                          {:team-id team-id
-                           :profile-id profile-id
-                           :is-owner owner?
-                           :is-admin true
-                           :can-edit true}))
-
-            (setup-team [conn team-id profile-ids]
-              (l/info :action "setup team"
-                      :team-id team-id
-                      :profile-ids (pr-str profile-ids))
-              (assign-profile-to-team conn team-id true (first profile-ids))
-              (run! (partial assign-profile-to-team conn team-id false)
-                    (rest profile-ids))
-              (create-projects conn team-id profile-ids))
-
-            (assign-teams-and-profiles [conn teams profiles]
-              (l/info :action "assign teams and profiles")
-              (loop [team-id (first teams)
-                     teams (rest teams)]
-                (when-not (nil? team-id)
-                  (let [n-profiles-team (:num-profiles-per-team opts)
-                        selected-profiles (rng-vec rng profiles n-profiles-team)]
-                    (setup-team conn team-id selected-profiles)
-                    (recur (first teams)
-                           (rest teams))))))
-
-            (create-draft-file [conn owner index]
-              (let [owner-id   (:id owner)
-                    id         (mk-uuid "file" "draft" owner-id index)
-                    name       (str "file" index)
-                    project-id (:default-project-id owner)
-                    data       (cp/make-file-data id)]
-
-                (l/info :action "create draft file"
-                        :index index
-                        :id id)
-                (db/insert! conn :file
-                            {:id id
-                             :data (blob/encode data)
-                             :project-id project-id
-                             :name name})
-                (db/insert! conn :file-profile-rel
-                            {:file-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-draft-files [conn profile]
-              (run! (partial create-draft-file conn profile)
-                    (range (:num-draft-files-per-profile opts))))
-            ]
-      (db/with-atomic [conn pool]
-        (let [profiles (create-profiles conn)
-              teams    (create-teams conn)]
-          (assign-teams-and-profiles conn teams (map :id profiles))
-          (run! (partial create-draft-files conn) profiles))))))
-
-(defn run-in-system
-  [system preset]
-  (let [pool   (:app.db/pool system)
-        preset (if (map? preset)
-                 preset
-                 (case preset
-                   (nil "small" :small) preset-small
-                   ;; "medium" preset-medium
-                   ;; "big" preset-big
-                   preset-small))]
-    (impl-run pool preset)))
-
-(defn run
-  [{:keys [preset] :or {preset :small}}]
-  (let [config (select-keys main/system-config
-                            [:app.db/pool
-                             :app.telemetry/migrations
-                             :app.migrations/migrations
-                             :app.migrations/all
-                             :app.metrics/metrics])
-        _      (ig/load-namespaces config)
-        system (-> (ig/prep config)
-                   (ig/init))]
-    (try
-      (run-in-system system preset)
-      (catch Exception e
-        (l/error :hint "unhandled exception" :cause e))
-      (finally
-        (ig/halt! system)))))

backend/src/app/config.clj

@@ -51,6 +51,9 @@
    :default-blob-version 3
    :loggers-zmq-uri "tcp://localhost:45556"
 
+   :file-change-snapshot-every 5
+   :file-change-snapshot-timeout "3h"
+
    :public-uri "http://localhost:3449"
    :redis-uri "redis://redis/0"
 
@@ -62,8 +65,9 @@
 
    :assets-path "/internal/assets/"
 
-   :rlimits-password 10
-   :rlimits-image 2
+   :rlimit-password 10
+   :rlimit-image 2
+   :rlimit-font 5
 
    :smtp-default-reply-to "Penpot <no-reply@example.com>"
    :smtp-default-from "Penpot <no-reply@example.com>"
@@ -85,7 +89,7 @@
    ;; a server prop key where initial project is stored.
    :initial-project-skey "initial-project"})
 
-(s/def ::flags ::us/words)
+(s/def ::flags ::us/set-of-keywords)
 
 ;; DEPRECATED PROPERTIES: should be removed in 1.10
 (s/def ::registration-enabled ::us/boolean)
@@ -97,6 +101,10 @@
 (s/def ::audit-log-archive-uri ::us/string)
 (s/def ::audit-log-gc-max-age ::dt/duration)
 
+(s/def ::admins ::us/set-of-str)
+(s/def ::file-change-snapshot-every ::us/integer)
+(s/def ::file-change-snapshot-timeout ::dt/duration)
+
 (s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::assets-path ::us/string)
@@ -151,8 +159,9 @@
 (s/def ::public-uri ::us/string)
 (s/def ::redis-uri ::us/string)
 (s/def ::registration-domain-whitelist ::us/set-of-str)
-(s/def ::rlimits-image ::us/integer)
-(s/def ::rlimits-password ::us/integer)
+(s/def ::rlimit-font ::us/integer)
+(s/def ::rlimit-image ::us/integer)
+(s/def ::rlimit-password ::us/integer)
 (s/def ::smtp-default-from ::us/string)
 (s/def ::smtp-default-reply-to ::us/string)
 (s/def ::smtp-host ::us/string)
@@ -183,6 +192,7 @@
 (s/def ::config
   (s/keys :opt-un [::secret-key
                    ::flags
+                   ::admins
                    ::allow-demo-users
                    ::audit-log-archive-uri
                    ::audit-log-gc-max-age
@@ -191,6 +201,8 @@
                    ::database-username
                    ::default-blob-version
                    ::error-report-webhook
+                   ::file-change-snapshot-every
+                   ::file-change-snapshot-timeout
                    ::user-feedback-destination
                    ::github-client-id
                    ::github-client-secret
@@ -237,8 +249,9 @@
                    ::redis-uri
                    ::registration-domain-whitelist
                    ::registration-enabled
-                   ::rlimits-image
-                   ::rlimits-password
+                   ::rlimit-font
+                   ::rlimit-image
+                   ::rlimit-password
                    ::sentry-dsn
                    ::sentry-debug
                    ::sentry-attach-stack-trace
@@ -268,10 +281,16 @@
                    ::telemetry-with-taiga
                    ::tenant]))
 
+(def default-flags
+  [:enable-backend-asserts
+   :enable-backend-api-doc
+   :enable-secure-session-cookies])
+
 (defn- parse-flags
   [config]
-  (-> (:flags config)
-      (flags/parse flags/default)))
+  (flags/parse flags/default
+               default-flags
+               (:flags config)))
 
 (defn read-env
   [prefix]

backend/src/app/db.clj

@@ -27,14 +27,16 @@
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
    com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
+   java.io.InputStream
+   java.io.OutputStream
    java.lang.AutoCloseable
    java.sql.Connection
    java.sql.Savepoint
    org.postgresql.PGConnection
    org.postgresql.geometric.PGpoint
+   org.postgresql.jdbc.PgArray
    org.postgresql.largeobject.LargeObject
    org.postgresql.largeobject.LargeObjectManager
-   org.postgresql.jdbc.PgArray
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
@@ -113,7 +115,7 @@
       (.setIdleTimeout 120000)       ;; 2min
       (.setMaxLifetime 1800000)      ;; 30min
       (.setMinimumIdle (:min-pool-size cfg 0))
-      (.setMaximumPoolSize (:max-pool-size cfg 30))
+      (.setMaximumPoolSize (:max-pool-size cfg 50))
       (.setConnectionInitSql initsql)
       (.setInitializationFailTimeout -1))
 
@@ -356,7 +358,7 @@
         val (.getValue o)]
     (if (or (= typ "json")
             (= typ "jsonb"))
-      (json/decode-str val)
+      (json/read val)
       val)))
 
 (defn decode-transit-pgobject
@@ -392,7 +394,7 @@
   [data]
   (doto (org.postgresql.util.PGobject.)
     (.setType "jsonb")
-    (.setValue (json/encode-str data))))
+    (.setValue (json/write-str data))))
 
 ;; --- Locks
 

backend/src/app/emails.clj

@@ -66,8 +66,8 @@
                               (:id profile)
                               (db/interval bounce-max-age)])]
 
-      (and (< complaints complaint-threshold)
-           (< bounces bounce-threshold)))))
+      (and (< (or complaints 0) complaint-threshold)
+           (< (or bounces 0) bounce-threshold)))))
 
 (defn has-complaint-reports?
   ([conn email] (has-complaint-reports? conn email nil))

backend/src/app/http.clj

@@ -12,6 +12,7 @@
    [app.common.spec :as us]
    [app.http.doc :as doc]
    [app.http.errors :as errors]
+   [app.http.debug :as debug]
    [app.http.middleware :as middleware]
    [app.metrics :as mtx]
    [clojure.spec.alpha :as s]
@@ -90,20 +91,9 @@
       (try
         (handler request)
         (catch Throwable e
-          (try
-            (let [cdata (errors/get-error-context request e)]
-              (l/update-thread-context! cdata)
-              (l/error :hint "unhandled exception"
-                       :message (ex-message e)
-                       :error-id (str (:id cdata))
-                       :cause e))
-            {:status 500 :body "internal server error"}
-            (catch Throwable e
-              (l/error :hint "unhandled exception"
-                       :message (ex-message e)
-                       :cause e)
-              {:status 500 :body "internal server error"})))))))
-
+          (l/with-context (errors/get-error-context request e)
+            (l/error :hint (ex-message e) :cause e)
+            {:status 500 :body "internal server error"}))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Http Main Handler (Router)
@@ -115,17 +105,16 @@
 (s/def ::storage map?)
 (s/def ::assets map?)
 (s/def ::feedback fn?)
-(s/def ::error-report-handler fn?)
 (s/def ::audit-http-handler fn?)
+(s/def ::debug map?)
 
 (defmethod ig/pre-init-spec ::router [_]
   (s/keys :req-un [::rpc ::session ::mtx/metrics
                    ::oauth ::storage ::assets ::feedback
-                   ::error-report-handler
-                   ::audit-http-handler]))
+                   ::debug ::audit-http-handler]))
 
 (defmethod ig/init-key ::router
-  [_ {:keys [session rpc oauth metrics assets feedback] :as cfg}]
+  [_ {:keys [session rpc oauth metrics assets feedback debug] :as cfg}]
   (rr/router
    [["/metrics" {:get (:handler metrics)}]
     ["/assets" {:middleware [[middleware/format-response-body]
@@ -136,8 +125,17 @@
      ["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
      ["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
 
-    ["/dbg"
-     ["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
+    ["/dbg" {:middleware [[middleware/params]
+                          [middleware/keyword-params]
+                          [middleware/format-response-body]
+                          [middleware/errors errors/handle]
+                          [middleware/cookies]
+                          [(:middleware session)]]}
+     ["/error-by-id/:id" {:get (:retrieve-error debug)}]
+     ["/error/:id" {:get (:retrieve-error debug)}]
+     ["/error" {:get (:retrieve-error-list debug)}]
+     ["/file/data/:id" {:get (:retrieve-file-data debug)}]
+     ["/file/changes/:id" {:get (:retrieve-file-changes debug)}]]
 
     ["/webhooks"
      ["/sns" {:post (:sns-webhook cfg)}]]

backend/src/app/http/debug.clj

@@ -0,0 +1,165 @@
+;; 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.debug
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.rpc.queries.profile :as profile]
+   [app.util.blob :as blob]
+   [app.util.json :as json]
+   [app.util.template :as tmpl]
+   [app.util.time :as dt]
+   [clojure.java.io :as io]
+   [clojure.pprint :as ppr]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(def sql:retrieve-range-of-changes
+  "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
+
+(def sql:retrieve-single-change
+  "select revn, changes, data from file_change where file_id=? and revn = ?")
+
+(defn authorized?
+  [pool {:keys [profile-id]}]
+  (or (= "devenv" (cf/get :host))
+      (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id))
+            admins  (or (cf/get :admins) #{})]
+        (contains? admins (:email profile)))))
+
+(defn prepare-response
+  [body]
+  (when-not body
+    (ex/raise :type :not-found
+              :code :enpty-data
+              :hint "empty response"))
+
+  {:status 200
+   :headers {"content-type" "application/transit+json"}
+   :body body})
+
+(defn retrieve-file-data
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [id    (some-> (get-in request [:path-params :id]) uuid/uuid)
+        revn  (some-> (get-in request [:params :revn]) d/parse-integer)]
+    (when-not id
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (if (integer? revn)
+      (let [fchange (db/exec-one! pool [sql:retrieve-single-change id revn])]
+        (prepare-response (some-> fchange :data blob/decode)))
+
+      (let [file (db/get-by-id pool :file id)]
+        (prepare-response (some-> file :data blob/decode))))))
+
+(defn retrieve-file-changes
+  [{:keys [pool]} {:keys [params path-params profile-id] :as request}]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [id    (some-> (get-in request [:path-params :id]) uuid/uuid)
+        revn  (get-in request [:params :revn] "latest")]
+
+    (when (or (not id) (not revn))
+      (ex/raise :type :validation
+                :code :invalid-arguments
+                :hint "missing arguments"))
+
+    (cond
+      (d/num-string? revn)
+      (let [item (db/exec-one! pool [sql:retrieve-single-change id (d/parse-integer revn)])]
+        (prepare-response (some-> item :changes blob/decode vec)))
+
+      (str/includes? revn ":")
+      (let [[start end] (->> (str/split revn #":")
+                             (map str/trim)
+                             (map d/parse-integer))
+            items       (db/exec! pool [sql:retrieve-range-of-changes id start end])]
+        (prepare-response  (some->> items
+                                    (map :changes)
+                                    (map blob/decode)
+                                    (mapcat identity)
+                                    (vec))))
+
+      :else
+      (ex/raise :type :validation :code :invalid-arguments))))
+
+
+(defn retrieve-error
+  [{:keys [pool]} request]
+  (letfn [(parse-id [request]
+            (let [id (get-in request [:path-params :id])
+                  id (us/uuid-conformer id)]
+              (when (uuid? id)
+                id)))
+
+          (retrieve-report [id]
+            (ex/ignoring
+             (some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject)))
+
+          (render-template [report]
+            (binding [ppr/*print-right-margin* 300]
+              (let [context (dissoc report :trace :cause :params :data :spec-prob :spec-problems :error :explain)
+                    params  {:context (with-out-str (ppr/pprint context))
+                             :data    (:data report)
+                             :trace   (or (:cause report)
+                                          (:trace report)
+                                          (some-> report :error :trace))
+                             :params  (:params report)}]
+                (-> (io/resource "error-report.tmpl")
+                    (tmpl/render params)))))
+          ]
+
+    (when-not (authorized? pool request)
+      (ex/raise :type :authentication
+                :code :only-admins-allowed))
+
+    (let [result (some-> (parse-id request)
+                         (retrieve-report)
+                         (render-template))]
+      (if result
+        {:status 200
+         :headers {"content-type" "text/html; charset=utf-8"
+                   "x-robots-tag" "noindex"}
+         :body result}
+        {:status 404
+         :body "not found"}))))
+
+(def sql:error-reports
+  "select id, created_at from server_error_report order by created_at desc limit 100")
+
+(defn retrieve-error-list
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+  (let [items (db/exec! pool [sql:error-reports])
+        items (map #(update % :created-at dt/format-instant :rfc1123) items)]
+    {:status 200
+     :headers {"content-type" "text/html; charset=utf-8"
+               "x-robots-tag" "noindex"}
+     :body (-> (io/resource "error-list.tmpl")
+               (tmpl/render {:items items}))}))
+
+(defmethod ig/init-key ::handlers
+  [_ {:keys [pool] :as cfg}]
+  {:retrieve-file-data (partial retrieve-file-data cfg)
+   :retrieve-file-changes (partial retrieve-file-changes cfg)
+   :retrieve-error (partial retrieve-error cfg)
+   :retrieve-error-list (partial retrieve-error-list cfg)})

backend/src/app/http/doc.clj

@@ -45,7 +45,7 @@
 (defn handler
   [rpc]
   (let [context (prepare-context rpc)]
-    (if (contains? cf/flags :api-doc)
+    (if (contains? cf/flags :backend-api-doc)
       (fn [_]
         {:status 200
          :body (-> (io/resource "api-doc.tmpl")

backend/src/app/http/errors.clj

@@ -7,11 +7,11 @@
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
-   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.uuid :as uuid]
    [clojure.pprint]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 (defn- parse-client-ip
@@ -20,36 +20,23 @@
       (get headers "x-real-ip")
       (get request :remote-addr)))
 
-(defn- stringify-data
-  [data]
-  (binding [clojure.pprint/*print-right-margin* 200]
-    (let [result (with-out-str (clojure.pprint/pprint data))]
-      (str/prune result (* 1024 1024) "[...]"))))
-
 (defn get-error-context
   [request error]
   (let [data (ex-data error)]
-    (d/without-nils
-     (merge
-      {:id      (str (uuid/next))
-       :path    (str (:uri request))
-       :method  (name (:request-method request))
-       :hint    (or (:hint data) (ex-message error))
-       :params  (stringify-data (:params request))
-       :data    (stringify-data (dissoc data :explain))
-       :ip-addr (parse-client-ip request)
-       :explain (str/prune (:explain data) (* 1024 1024) "[...]")}
-
-     (when-let [id (:profile-id request)]
-       {:profile-id id})
+    (merge
+     {:id            (uuid/next)
+      :path          (:uri request)
+      :method        (:request-method request)
+      :hint          (or (:hint data) (ex-message error))
+      :params        (l/stringify-data (:params request))
+      :spec-problems (some-> data ::s/problems)
+      :data          (some-> data (dissoc ::s/problems))
+      :ip-addr       (parse-client-ip request)
+      :profile-id    (:profile-id request)}
 
      (let [headers (:headers request)]
        {:user-agent (get headers "user-agent")
-        :frontend-version (get headers "x-frontend-version" "unknown")})
-
-     (when (map? data)
-       {:error-type (:type data)
-        :error-code (:code data)})))))
+        :frontend-version (get headers "x-frontend-version" "unknown")}))))
 
 (defmulti handle-exception
   (fn [err & _rest]
@@ -66,32 +53,19 @@
   {:status 400 :body (ex-data err)})
 
 (defmethod handle-exception :validation
-  [err req]
-  (let [header (get-in req [:headers "accept"])
-        edata  (ex-data err)]
-    (if (and (= :spec-validation (:code edata))
-             (str/starts-with? header "text/html"))
-      {:status 400
-       :headers {"content-type" "text/html"}
-       :body (str "<pre style='font-size:16px'>"
-                  (:explain edata)
-                  "</pre>\n")}
-      {:status 400
-       :body   (dissoc edata :data)})))
+  [err _]
+  (let [edata (ex-data err)]
+    {:status 400 :body (dissoc edata ::s/problems)}))
 
 (defmethod handle-exception :assertion
   [error request]
-  (let [edata (ex-data error)
-        cdata (get-error-context request error)]
-    (l/update-thread-context! cdata)
-    (l/error :hint "internal error: assertion"
-             :error-id (str (:id cdata))
-             :cause error)
-
+  (let [edata (ex-data error)]
+    (l/with-context (get-error-context request error)
+      (l/error :hint (ex-message error) :cause error))
     {:status 500
      :body {:type :server-error
             :code :assertion
-            :data (dissoc edata :data)}}))
+            :data (dissoc edata ::s/problems)}}))
 
 (defmethod handle-exception :not-found
   [err _]
@@ -108,12 +82,10 @@
     (if (and (ex/exception? (:rollback edata))
              (ex/exception? (:handling edata)))
       (handle-exception (:handling edata) request)
-      (let [cdata (get-error-context request error)]
-        (l/update-thread-context! cdata)
-        (l/error :hint "internal error"
-                 :error-message (ex-message error)
-                 :error-id (str (:id cdata))
-                 :cause error)
+      (do
+        (l/with-context (get-error-context request error)
+          (l/error :hint (ex-message error) :cause error))
+
         {:status 500
          :body {:type :server-error
                 :code :unexpected
@@ -122,15 +94,13 @@
 
 (defmethod handle-exception org.postgresql.util.PSQLException
   [error request]
-  (let [cdata (get-error-context request error)
-        state (.getSQLState ^java.sql.SQLException error)]
+  (let [state (.getSQLState ^java.sql.SQLException error)]
 
-    (l/update-thread-context! cdata)
-    (l/error :hint "psql exception"
-             :error-message (ex-message error)
-             :error-id (str (:id cdata))
-             :sql-state state
-             :cause error)
+    (l/with-context (get-error-context request error)
+      (l/error :hint "psql exception"
+               :error-message (ex-message error)
+               :state state
+               :cause error))
 
     (cond
       (= state "57014")

backend/src/app/http/feedback.clj

@@ -61,6 +61,7 @@
         destination (cf/get :feedback-destination)]
     (eml/send! {::eml/conn pool
                 ::eml/factory eml/feedback
+                :from     destination
                 :to       destination
                 :profile  profile
                 :reply-to (:from params)

backend/src/app/http/middleware.clj

@@ -13,7 +13,6 @@
    [app.util.json :as json]
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
-   [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
@@ -36,8 +35,7 @@
               (t/read! reader)))
 
           (parse-json [body]
-            (let [reader (io/reader body)]
-              (json/read reader)))
+            (json/read body))
 
           (parse [type body]
             (try

backend/src/app/http/oauth.clj

@@ -58,8 +58,7 @@
           {:token (get data "access_token")
            :type  (get data "token_type")})))
     (catch Exception e
-      (l/error :hint "unexpected error on retrieve-access-token"
-               :cause e)
+      (l/warn :hint "unexpected error on retrieve-access-token" :cause e)
       nil)))
 
 (defn- qualify-props
@@ -86,8 +85,7 @@
            :props (->> (dissoc info :name :email)
                        (qualify-props provider))})))
     (catch Exception e
-      (l/error :hint "unexpected exception on retrieve-user-info"
-               :cause e)
+      (l/warn :hint "unexpected exception on retrieve-user-info" :cause e)
       nil)))
 
 (s/def ::backend ::us/not-empty-string)
@@ -203,6 +201,7 @@
            (sxf request)))
     (let [info   (assoc info
                         :iss :prepared-register
+                        :is-active true
                         :exp (dt/in-future {:hours 48}))
           token  (tokens :generate info)
           params (d/without-nils

backend/src/app/http/session.clj

@@ -53,12 +53,15 @@
 
 (defn- add-cookies
   [response {:keys [id] :as session}]
-  (let [cors? (contains? cfg/flags :cors)]
+  (let [cors?   (contains? cfg/flags :cors)
+        secure? (contains? cfg/flags :secure-session-cookies)]
     (assoc response :cookies {cookie-name {:path "/"
                                            :http-only true
                                            :value id
-                                           :same-site (if cors? :none :strict)
-                                           :secure true}})))
+                                           :same-site (cond (not secure?) :lax
+                                                            cors?         :none
+                                                            :else         :strict)
+                                           :secure secure?}})))
 
 (defn- clear-cookies
   [response]
@@ -70,7 +73,7 @@
     (if-let [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
       (do
         (a/>!! (::events-ch cfg) id)
-        (l/update-thread-context! {:profile-id profile-id})
+        (l/set-context! {:profile-id profile-id})
         (handler (assoc request :profile-id profile-id)))
       (handler request))))
 
@@ -177,7 +180,7 @@
 
 (defmethod ig/prep-key ::gc-task
   [_ cfg]
-  (merge {:max-age (dt/duration {:days 2})}
+  (merge {:max-age (dt/duration {:days 15})}
          (d/without-nils cfg)))
 
 (defmethod ig/init-key ::gc-task

backend/src/app/loggers/database.clj

@@ -14,10 +14,8 @@
    [app.config :as cf]
    [app.db :as db]
    [app.util.async :as aa]
-   [app.util.template :as tmpl]
    [app.worker :as wrk]
    [clojure.core.async :as a]
-   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
@@ -36,7 +34,7 @@
     (db/insert! conn :server-error-report
                 {:id id :content (db/tjson event)})))
 
-(defn- parse-context
+(defn- parse-event-data
   [event]
   (reduce-kv
    (fn [acc k v]
@@ -46,12 +44,11 @@
        (str/blank? v)    acc
        :else             (assoc acc k v)))
    {}
-   (:context event)))
+   event))
 
 (defn parse-event
   [event]
-  (-> (parse-context event)
-      (merge (dissoc event :context))
+  (-> (parse-event-data event)
       (assoc :tenant (cf/get :tenant))
       (assoc :host (cf/get :host))
       (assoc :public-uri (cf/get :public-uri))
@@ -61,7 +58,10 @@
   [{:keys [executor] :as cfg} event]
   (aa/with-thread executor
     (try
-      (let [event (parse-event event)]
+      (let [event (parse-event event)
+            uri   (cf/get :public-uri)]
+        (l/debug :hint "registering error on database" :id (:id event)
+                 :uri (str uri "/dbg/error/" (:id event)))
         (persist-on-database! cfg event))
       (catch Exception e
         (l/warn :hint "unexpected exception on database error logger"
@@ -74,7 +74,8 @@
   [_ {:keys [receiver] :as cfg}]
   (l/info :msg "initializing database error persistence")
   (let [output (a/chan (a/sliding-buffer 128)
-                       (filter #(= (:level %) "error")))]
+                       (filter (fn [event]
+                                 (= (:logger/level event) "error"))))]
     (receiver :sub output)
     (a/go-loop []
       (let [msg (a/<! output)]
@@ -88,39 +89,3 @@
 (defmethod ig/halt-key! ::reporter
   [_ output]
   (a/close! output))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool]))
-
-(defmethod ig/init-key ::handler
-  [_ {:keys [pool] :as cfg}]
-  (letfn [(parse-id [request]
-            (let [id (get-in request [:path-params :id])
-                  id (us/uuid-conformer id)]
-              (when (uuid? id)
-                id)))
-          (retrieve-report [id]
-            (ex/ignoring
-             (when-let [{:keys [content] :as row} (db/get-by-id pool :server-error-report id)]
-               (assoc row :content (db/decode-transit-pgobject content)))))
-
-          (render-template [{:keys [content] :as report}]
-            (some-> (io/resource "error-report.tmpl")
-                    (tmpl/render content)))]
-
-
-    (fn [request]
-      (let [result (some-> (parse-id request)
-                           (retrieve-report)
-                           (render-template))]
-        (if result
-          {:status 200
-           :headers {"content-type" "text/html; charset=utf-8"
-                     "x-robots-tag" "noindex"}
-           :body result}
-          {:status 404
-           :body "not found"})))))

backend/src/app/loggers/loki.clj

@@ -68,7 +68,7 @@
                                 :timeout 6000
                                 :method :post
                                 :headers {"content-type" "application/json"}
-                                :body (json/encode payload)})]
+                                :body (json/write payload)})]
       (cond
         (= (:status response) 204)
         true

backend/src/app/loggers/mattermost.clj

@@ -25,13 +25,13 @@
   [cfg {:keys [host id public-uri] :as event}]
   (try
     (let [uri  (:uri cfg)
-          text (str "Exception on (host: " host ", url: " public-uri "/dbg/error-by-id/" id ")\n"
+          text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
                     (when-let [pid (:profile-id event)]
                       (str "- profile-id: #uuid-" pid "\n")))
           rsp  (http/send! {:uri uri
                             :method :post
                             :headers {"content-type" "application/json"}
-                            :body (json/encode-str {:text text})})]
+                            :body (json/write-str {:text text})})]
       (when (not= (:status rsp) 200)
         (l/error :hint "error on sending data to mattermost"
                  :response (pr-str rsp))))
@@ -62,7 +62,8 @@
   (when uri
     (l/info :msg "initializing mattermost error reporter" :uri uri)
     (let [output (a/chan (a/sliding-buffer 128)
-                         (filter #(= (:level %) "error")))]
+                         (filter (fn [event]
+                                   (= (:logger/level event) "error"))))]
       (receiver :sub output)
       (a/go-loop []
         (let [msg (a/<! output)]

backend/src/app/loggers/zmq.clj

@@ -7,6 +7,7 @@
 (ns app.loggers.zmq
   "A generic ZMQ listener."
   (:require
+   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.util.json :as json]
@@ -33,7 +34,7 @@
   (l/info :msg "intializing ZMQ receiver" :bind endpoint)
   (let [buffer (a/chan 1)
         output (a/chan 1 (comp (filter map?)
-                               (map prepare)))
+                               (keep prepare)))
         mult   (a/mult output)]
     (when endpoint
       (a/thread (start-rcv-loop {:out buffer :endpoint endpoint})))
@@ -52,6 +53,11 @@
   [_ f]
   (a/close! (::buffer (meta f))))
 
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)}))
+
 (defn- start-rcv-loop
   ([] (start-rcv-loop nil))
   ([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}]
@@ -63,7 +69,7 @@
      (.. socket (setReceiveTimeOut 5000))
      (loop []
        (let [msg (.recv ^ZMQ$Socket socket)
-             msg (json/decode msg)
+             msg (ex/ignoring (json/read msg json-mapper))
              msg (if (nil? msg) :empty msg)]
          (if (a/>!! out msg)
            (recur)
@@ -71,18 +77,30 @@
              (.close ^java.lang.AutoCloseable socket)
              (.close ^java.lang.AutoCloseable zctx))))))))
 
+(s/def ::logger-name string?)
+(s/def ::level string?)
+(s/def ::thread string?)
+(s/def ::time-millis integer?)
+(s/def ::message string?)
+(s/def ::context-map map?)
+(s/def ::throw map?)
+
+(s/def ::log4j-event
+  (s/keys :req-un [::logger-name ::level ::thread ::time-millis ::message]
+          :opt-un [::context-map ::thrown]))
+
 (defn- prepare
   [event]
-  (merge
-   {:logger     (:loggerName event)
-    :level      (str/lower (:level event))
-    :thread     (:thread event)
-    :created-at (dt/instant (:timeMillis event))
-    :message    (:message event)}
-   (when-let [ctx (:contextMap event)]
-     {:context ctx})
-   (when-let [thrown (:thrown event)]
-     {:error
-      {:class (:name thrown)
-       :message (:message thrown)
-       :trace (:extendedStackTrace thrown)}})))
+  (if (s/valid? ::log4j-event event)
+    (merge {:message      (:message event)
+            :created-at   (dt/instant (:time-millis event))
+            :logger/name  (:logger-name event)
+            :logger/level (str/lower (:level event))}
+
+           (when-let [thrown (:thrown event)]
+             {:trace (:extended-stack-trace thrown)})
+
+           (:context-map event))
+    (do
+      (l/warn :hint "invalid event" :event event)
+      nil)))

backend/src/app/main.clj

@@ -106,8 +106,11 @@
     :storage     (ig/ref :app.storage/storage)
     :sns-webhook (ig/ref :app.http.awsns/handler)
     :feedback    (ig/ref :app.http.feedback/handler)
-    :audit-http-handler   (ig/ref :app.loggers.audit/http-handler)
-    :error-report-handler (ig/ref :app.loggers.database/handler)}
+    :debug                (ig/ref :app.http.debug/handlers)
+    :audit-http-handler   (ig/ref :app.loggers.audit/http-handler)}
+
+   :app.http.debug/handlers
+   {:pool (ig/ref :app.db/pool)}
 
    :app.http.assets/handlers
    {:metrics           (ig/ref :app.metrics/metrics)
@@ -127,24 +130,6 @@
     :audit         (ig/ref :app.loggers.audit/collector)
     :public-uri    (cf/get :public-uri)}
 
-   ;; RLimit definition for password hashing
-   :app.rlimits/password
-   (cf/get :rlimits-password)
-
-   ;; RLimit definition for image processing
-   :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)
-    :font     (ig/ref :app.rlimits/font)}
-
    :app.rpc/rpc
    {:pool       (ig/ref :app.db/pool)
     :session    (ig/ref :app.http.session/session)
@@ -152,7 +137,6 @@
     :metrics    (ig/ref :app.metrics/metrics)
     :storage    (ig/ref :app.storage/storage)
     :msgbus     (ig/ref :app.msgbus/msgbus)
-    :rlimits    (ig/ref :app.rlimits/all)
     :public-uri (cf/get :public-uri)
     :audit      (ig/ref :app.loggers.audit/collector)}
 
@@ -325,9 +309,6 @@
     :pool     (ig/ref :app.db/pool)
     :executor (ig/ref :app.worker/executor)}
 
-   :app.loggers.database/handler
-   {:pool (ig/ref :app.db/pool)}
-
    :app.loggers.sentry/reporter
    {:dsn                (cf/get :sentry-dsn)
     :trace-sample-rate  (cf/get :sentry-trace-sample-rate 1.0)

backend/src/app/media.clj

@@ -12,7 +12,6 @@
    [app.common.media :as cm]
    [app.common.spec :as us]
    [app.config :as cf]
-   [app.rlimits :as rlm]
    [app.util.svg :as svg]
    [buddy.core.bytes :as bb]
    [buddy.core.codecs :as bc]
@@ -51,7 +50,6 @@
                :code :media-type-not-allowed
                :hint "Seems like you are uploading an invalid media object"))))
 
-
 (defmulti process :cmd)
 (defmulti process-error class)
 
@@ -66,17 +64,11 @@
   (throw 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)))))
+  [params]
+  (try
+    (process params)
+    (catch Throwable e
+      (process-error e))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; --- Thumbnails Generation

backend/src/app/msgbus.clj

@@ -179,18 +179,18 @@
     ;; Add a unique listener to connection
     (.addListener sub-conn
                   (reify RedisPubSubListener
-                    (message [it pattern topic message])
-                    (message [it topic message]
+                    (message [_ _pattern _topic _message])
+                    (message [_ topic message]
                       ;; There are no back pressure, so we use a slidding
                       ;; buffer for cases when the pubsub broker sends
                       ;; more messages that we can process.
                       (let [val {:topic topic :message (blob/decode message)}]
                         (when-not (a/offer! rcv-ch val)
                           (l/warn :msg "dropping message on subscription loop"))))
-                    (psubscribed [it pattern count])
-                    (punsubscribed [it pattern count])
-                    (subscribed [it topic count])
-                    (unsubscribed [it topic count])))
+                    (psubscribed [_ _pattern _count])
+                    (punsubscribed [_ _pattern _count])
+                    (subscribed [_ _topic _count])
+                    (unsubscribed [_ _topic _count])))
 
     (letfn [(subscribe-to-single-topic [nsubs topic chan]
               (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]

backend/src/app/rlimits.clj

@@ -1,45 +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.rlimits
-  "Resource usage limits (in other words: semaphores)."
-  (:require
-   [app.common.spec :as us]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig])
-  (:import
-   java.util.concurrent.Semaphore))
-
-(s/def ::rlimit  #(instance? Semaphore %))
-(s/def ::rlimits (s/map-of ::us/keyword ::rlimit))
-
-(derive ::password ::instance)
-(derive ::image ::instance)
-(derive ::font ::instance)
-
-(defmethod ig/pre-init-spec ::instance [_]
-  (s/spec int?))
-
-(defmethod ig/init-key ::instance
-  [_ permits]
-  (Semaphore. (int permits)))
-
-(defn acquire!
-  [sem]
-  (.acquire ^Semaphore sem))
-
-(defn release!
-  [sem]
-  (.release ^Semaphore sem))
-
-(defmacro execute
-  [rlinst & body]
-  `(try
-     (acquire! ~rlinst)
-     ~@body
-     (finally
-       (release! ~rlinst))))
-

backend/src/app/rpc.clj

@@ -13,10 +13,10 @@
    [app.db :as db]
    [app.loggers.audit :as audit]
    [app.metrics :as mtx]
-   [app.rlimits :as rlm]
+   [app.util.retry :as retry]
+   [app.util.rlimit :as rlimit]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
    [integrant.core :as ig]))
 
 (defn- default-handler
@@ -73,33 +73,19 @@
   [cfg f mdata]
   (mtx/wrap-summary f (::mobj cfg) [(::sv/name mdata)]))
 
-;; Wrap the rpc handler with a semaphore if it is specified in the
-;; metadata asocciated with the handler.
-(defn- wrap-with-rlimits
-  [cfg f mdata]
-  (if-let [key (:rlimit mdata)]
-    (let [rlinst (get-in cfg [:rlimits key])]
-      (when-not rlinst
-        (ex/raise :type :internal
-                  :code :rlimit-not-configured
-                  :hint (str/fmt "%s rlimit not configured" key)))
-      (l/trace :action "add rlimit"
-               :handler (::sv/name mdata))
-      (fn [cfg params]
-        (rlm/execute rlinst (f cfg params))))
-    f))
-
 (defn- wrap-impl
   [{:keys [audit] :as cfg} f mdata]
-  (let [f      (wrap-with-rlimits cfg f mdata)
-        f      (wrap-with-metrics cfg f mdata)
-        spec   (or (::sv/spec mdata) (s/spec any?))
-        auth?  (:auth mdata true)]
+  (let [f     (as-> f $
+                (rlimit/wrap-rlimit cfg $ mdata)
+                (retry/wrap-retry cfg $ mdata)
+                (wrap-with-metrics cfg $ mdata))
+
+        spec  (or (::sv/spec mdata) (s/spec any?))
+        auth? (:auth mdata true)]
 
     (l/trace :action "register" :name (::sv/name mdata))
     (with-meta
       (fn [params]
-
         ;; Raise authentication error when rpc method requires auth but
         ;; no profile-id is found in the request.
         (when (and auth? (not (uuid? (:profile-id params))))
@@ -187,7 +173,7 @@
 
 (defmethod ig/pre-init-spec ::rpc [_]
   (s/keys :req-un [::storage ::session ::tokens ::audit
-                   ::mtx/metrics ::rlm/rlimits ::db/pool]))
+                   ::mtx/metrics ::db/pool]))
 
 (defmethod ig/init-key ::rpc
   [_ cfg]

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

@@ -12,6 +12,7 @@
    [app.rpc.queries.comments :as comments]
    [app.rpc.queries.files :as files]
    [app.util.blob :as blob]
+   [app.util.retry :as retry]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
@@ -32,6 +33,9 @@
   (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
 
 (sv/defmethod ::create-comment-thread
+  {::retry/enabled true
+   ::retry/max-retries 3
+   ::retry/matches retry/conflict-db-insert?}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-read-permissions! conn profile-id file-id)
@@ -43,7 +47,7 @@
         res (db/exec-one! conn [sql file-id])]
     (:next-seqn res)))
 
-(defn- create-comment-thread*
+(defn- create-comment-thread
   [conn {:keys [profile-id file-id page-id position content] :as params}]
   (let [seqn    (retrieve-next-seqn conn file-id)
         now     (dt/now)
@@ -78,24 +82,6 @@
 
     (select-keys thread [:id :file-id :page-id])))
 
-(defn- create-comment-thread
-  [conn params]
-  (loop [sp (db/savepoint conn)
-         rc 0]
-    (let [res (ex/try (create-comment-thread* conn params))]
-      (cond
-        (and (instance? Throwable res)
-             (< rc 3))
-        (do
-          (db/rollback! conn sp)
-          (recur (db/savepoint conn)
-                 (inc rc)))
-
-        (instance? Throwable res)
-        (throw res)
-
-        :else res))))
-
 (defn- retrieve-page-name
   [conn {:keys [file-id page-id]}]
   (let [{:keys [data]} (db/get-by-id conn :file file-id)

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

@@ -13,7 +13,6 @@
    [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]
    [app.util.time :as dt]
    [buddy.core.codecs :as bc]
@@ -34,10 +33,11 @@
         params   {:id id
                   :email email
                   :fullname fullname
-                  :is-demo true
+                  :is-active true
                   :deleted-at (dt/in-future cf/deletion-delay)
                   :password password
-                  :props {:onboarding-viewed true}}]
+                  :props {}
+                  }]
 
     (when-not (contains? cf/flags :demo-users)
       (ex/raise :type :validation
@@ -46,8 +46,7 @@
 
     (db/with-atomic [conn pool]
       (->> (#'profile/create-profile conn params)
-           (#'profile/create-profile-relations conn)
-           (sid/load-initial-project! conn))
+           (#'profile/create-profile-relations conn))
 
       (with-meta {:email email
                   :password password}

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

@@ -11,6 +11,7 @@
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.rpc.permissions :as perms]
@@ -280,11 +281,13 @@
 (defn- take-snapshot?
   "Defines the rule when file `data` snapshot should be saved."
   [{:keys [revn modified-at] :as file}]
-  ;; The snapshot will be saved every 20 changes or if the last
-  ;; modification is older than 3 hour.
-  (or (zero? (mod revn 20))
-      (> (inst-ms (dt/diff modified-at (dt/now)))
-         (inst-ms (dt/duration {:hours 3})))))
+  (let [freq    (or (cf/get :file-change-snapshot-every) 20)
+        timeout (or (cf/get :file-change-snapshot-timeout)
+                    (dt/duration {:hours 1}))]
+    (or (= 1 freq)
+        (zero? (mod revn freq))
+        (> (inst-ms (dt/diff modified-at (dt/now)))
+           (inst-ms timeout)))))
 
 (defn- delete-from-storage
   [{:keys [storage] :as cfg} file]
@@ -309,6 +312,8 @@
                   (mapcat :changes changes-with-metadata)
                   changes)
 
+        changes (vec changes)
+
         ;; Trace the number of changes processed
         _       ((::mtx/fn mtx1) {:by (count changes)})
 

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

@@ -9,10 +9,12 @@
    [app.common.exceptions :as ex]
    [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.rlimit :as rlimit]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
@@ -37,6 +39,7 @@
                    ::font-id ::font-family ::font-weight ::font-style]))
 
 (sv/defmethod ::create-font-variant
+  {::rlimit/permits (cf/get :rlimit-font)}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (let [cfg (assoc cfg :conn conn)]
@@ -45,10 +48,9 @@
 
 (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})
+  (let [data    (media/run {:cmd :generate-fonts :input data})
         storage (media/configure-assets-storage storage conn)
 
-
         otf     (when-let [fdata (get data "font/otf")]
                   (sto/put-object storage {:content (sto/content fdata)
                                            :content-type "font/otf"}))

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

@@ -10,11 +10,13 @@
    [app.common.media :as cm]
    [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.http :as http]
+   [app.util.rlimit :as rlimit]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
@@ -47,6 +49,7 @@
           :opt-un [::id]))
 
 (sv/defmethod ::upload-file-media-object
+  {::rlimit/permits (cf/get :rlimit-image)}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (let [file (select-file conn file-id)]
@@ -89,6 +92,15 @@
                          :content-type mtype
                          :expired-at (dt/in-future {:minutes 30})}))))
 
+;; NOTE: we use the `on conflict do update` instead of `do nothing`
+;; because postgresql does not returns anything if no update is
+;; performed, the `do update` does the trick.
+
+(def sql:create-file-media-object
+  "insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
+   values (?, ?, ?, ?, ?, ?, ?, ?, ?)
+       on conflict (id) do update set created_at=file_media_object.created_at
+       returning *")
 
 (defn create-file-media-object
   [{:keys [conn storage] :as cfg} {:keys [id file-id is-local name content] :as params}]
@@ -96,14 +108,14 @@
   (let [storage      (media/configure-assets-storage storage conn)
         source-path  (fs/path (:tempfile content))
         source-mtype (:content-type content)
-        source-info  (media/run cfg {:cmd :info :input {:path source-path :mtype source-mtype}})
+        source-info  (media/run {:cmd :info :input {:path source-path :mtype source-mtype}})
 
         thumb        (when (and (not (svg-image? source-info))
                                 (big-enough-for-thumbnail? source-info))
-                       (media/run cfg (assoc thumbnail-options
-                                             :cmd :generic-thumbnail
-                                             :input {:mtype (:mtype source-info)
-                                                     :path source-path})))
+                       (media/run (assoc thumbnail-options
+                                         :cmd :generic-thumbnail
+                                         :input {:mtype (:mtype source-info)
+                                                 :path source-path})))
 
         image        (if (= (:mtype source-info) "image/svg+xml")
                        (let [data (slurp source-path)]
@@ -115,17 +127,15 @@
         thumb        (when thumb
                        (sto/put-object storage {:content (sto/content (:data thumb) (:size thumb))
                                                 :content-type (:mtype thumb)}))]
-    (db/insert! conn :file-media-object
-                {:id (or id (uuid/next))
-                 :file-id file-id
-                 :is-local is-local
-                 :name name
-                 :media-id (:id image)
-                 :thumbnail-id (:id thumb)
-                 :width  (:width source-info)
-                 :height (:height source-info)
-                 :mtype  source-mtype})))
 
+    (db/exec-one! conn [sql:create-file-media-object
+                        (or id (uuid/next))
+                        file-id is-local name
+                        (:id image)
+                        (:id thumb)
+                        (:width source-info)
+                        (:height source-info)
+                        source-mtype])))
 
 ;; --- Create File Media Object (from URL)
 

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

@@ -16,11 +16,10 @@
    [app.loggers.audit :as audit]
    [app.media :as media]
    [app.metrics :as mtx]
-   [app.rpc.mutations.projects :as projects]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
-   [app.setup.initial-data :as sid]
    [app.storage :as sto]
+   [app.util.rlimit :as rlimit]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [buddy.hashers :as hashers]
@@ -126,13 +125,12 @@
 
 ;; --- MUTATION: Register Profile
 
-(s/def ::accept-terms-and-privacy ::us/boolean)
 (s/def ::token ::us/not-empty-string)
-
 (s/def ::register-profile
   (s/keys :req-un [::token ::fullname]))
 
-(sv/defmethod ::register-profile {:auth false :rlimit :password}
+(sv/defmethod ::register-profile
+  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
@@ -148,16 +146,17 @@
 
 (defn register-profile
   [{:keys [conn tokens session metrics] :as cfg} {:keys [token] :as params}]
-  (let [claims (tokens :verify {:token token :iss :prepared-register})
-        params (merge params claims)]
+  (let [claims    (tokens :verify {:token token :iss :prepared-register})
+        params    (merge params claims)]
+
     (check-profile-existence! conn params)
-    (let [profile (->> params
-                       (create-profile conn)
-                       (create-profile-relations conn)
-                       (decode-profile-row))]
-
-      (sid/load-initial-project! conn profile)
 
+    (let [is-active (or (:is-active params)
+                        (contains? cf/flags :insecure-register))
+          profile   (->> (assoc params :is-active is-active)
+                         (create-profile conn)
+                         (create-profile-relations conn)
+                         (decode-profile-row))]
       (cond
         ;; If invitation token comes in params, this is because the
         ;; user comes from team-invitation process; in this case,
@@ -187,6 +186,15 @@
            ::audit/props (audit/profile->props profile)
            ::audit/profile-id (:id profile)})
 
+        ;; If the `:enable-insecure-register` flag is set, we proceed
+        ;; to sign in the user directly, without email verification.
+        (true? is-active)
+        (with-meta (profile/strip-private-attrs profile)
+          {:transform-response ((:create session) (:id profile))
+           :before-complete (annotate-profile-register metrics)
+           ::audit/props (audit/profile->props profile)
+           ::audit/profile-id (:id profile)})
+
         ;; In all other cases, send a verification email.
         :else
         (let [vtoken (tokens :generate
@@ -231,7 +239,7 @@
         backend   (:backend params "penpot")
         is-demo   (:is-demo params false)
         is-muted  (:is-muted params false)
-        is-active (:is-active params (or (not= "penpot" backend) is-demo))
+        is-active (:is-active params false)
         email     (str/lower (:email params))
 
         params    {:id id
@@ -256,28 +264,15 @@
                       :code :email-already-exists
                       :cause e)))))))
 
-
 (defn create-profile-relations
   [conn profile]
-  (let [team    (teams/create-team conn {:profile-id (:id profile)
-                                         :name "Default"
-                                         :is-default true})
-        project (projects/create-project conn {:profile-id (:id profile)
-                                               :team-id (:id team)
-                                               :name "Drafts"
-                                               :is-default true})
-        params  {:team-id (:id team)
-                 :profile-id (:id profile)
-                 :project-id (:id project)
-                 :role :owner}]
-
-    (teams/create-team-role conn params)
-    (projects/create-project-role conn params)
-
+  (let [team (teams/create-team conn {:profile-id (:id profile)
+                                      :name "Default"
+                                      :is-default true})]
     (-> profile
         (profile/strip-private-attrs)
         (assoc :default-team-id (:id team))
-        (assoc :default-project-id (:id project)))))
+        (assoc :default-project-id (:default-project-id team)))))
 
 ;; --- MUTATION: Login
 
@@ -288,7 +283,8 @@
   (s/keys :req-un [::email ::password]
           :opt-un [::scope ::invitation-token]))
 
-(sv/defmethod ::login {:auth false :rlimit :password}
+(sv/defmethod ::login
+  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
   [{:keys [pool session tokens] :as cfg} {:keys [email password] :as params}]
   (letfn [(check-password [profile password]
             (when (= (:password profile) "!")
@@ -339,9 +335,9 @@
 ;; --- MUTATION: Logout
 
 (s/def ::logout
-  (s/keys :req-un [::profile-id]))
+  (s/keys :opt-un [::profile-id]))
 
-(sv/defmethod ::logout
+(sv/defmethod ::logout {:auth false}
   [{:keys [session] :as cfg} _]
   (with-meta {}
     {:transform-response (:delete session)}))
@@ -378,7 +374,8 @@
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
-(sv/defmethod ::update-profile-password {:rlimit :password}
+(sv/defmethod ::update-profile-password
+  {::rlimit/permits (cf/get :rlimit-password)}
   [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
     (let [profile (validate-password! conn params)]
@@ -411,11 +408,12 @@
   (s/keys :req-un [::profile-id ::file]))
 
 (sv/defmethod ::update-profile-photo
+  {::rlimit/permits (cf/get :rlimit-image)}
   [{:keys [pool storage] :as cfg} {:keys [profile-id file] :as params}]
   (db/with-atomic [conn pool]
     (media/validate-media-type (:content-type file) #{"image/jpeg" "image/png" "image/webp"})
-    (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                       :mtype (:content-type file)}})
+    (media/run {:cmd :info :input {:path (:tempfile file)
+                                   :mtype (:content-type file)}})
 
     (let [profile (db/get-by-id conn :profile profile-id)
           storage (media/configure-assets-storage storage conn)
@@ -561,7 +559,8 @@
 (s/def ::recover-profile
   (s/keys :req-un [::token ::password]))
 
-(sv/defmethod ::recover-profile {:auth false :rlimit :password}
+(sv/defmethod ::recover-profile
+  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
   [{:keys [pool tokens] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
             (let [tdata (tokens :verify {:token token :iss :password-recovery})]

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

@@ -10,6 +10,7 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.emails :as eml]
    [app.media :as media]
@@ -18,6 +19,7 @@
    [app.rpc.queries.profile :as profile]
    [app.rpc.queries.teams :as teams]
    [app.storage :as sto]
+   [app.util.rlimit :as rlimit]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
@@ -32,6 +34,7 @@
 ;; --- Mutation: Create Team
 
 (declare create-team)
+(declare create-team-entry)
 (declare create-team-role)
 (declare create-team-default-project)
 
@@ -42,15 +45,21 @@
 (sv/defmethod ::create-team
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [team   (create-team conn params)
-          params (assoc params
-                        :team-id (:id team)
-                        :role :owner)]
-      (create-team-role conn params)
-      (create-team-default-project conn params)
-      team)))
+    (create-team conn params)))
 
 (defn create-team
+  "This is a complete team creation process, it creates the team
+  object and all related objects (default role and default project)."
+  [conn params]
+  (let [team    (create-team-entry conn params)
+        params  (assoc params
+                       :team-id (:id team)
+                       :role :owner)
+        project (create-team-default-project conn params)]
+    (create-team-role conn params)
+    (assoc team :default-project-id (:id project))))
+
+(defn- create-team-entry
   [conn {:keys [id name is-default] :as params}]
   (let [id         (or id (uuid/next))
         is-default (if (boolean? is-default) is-default false)]
@@ -59,23 +68,24 @@
                  :name name
                  :is-default is-default})))
 
-(defn create-team-role
+(defn- create-team-role
   [conn {:keys [team-id profile-id role] :as params}]
   (let [params {:team-id team-id
                 :profile-id profile-id}]
     (->> (perms/assign-role-flags params role)
          (db/insert! conn :team-profile-rel))))
 
-(defn create-team-default-project
+(defn- create-team-default-project
   [conn {:keys [team-id profile-id] :as params}]
   (let [project {:id (uuid/next)
                  :team-id team-id
                  :name "Drafts"
-                 :is-default true}]
-    (projects/create-project conn project)
+                 :is-default true}
+        project (projects/create-project conn project)]
     (projects/create-project-role conn {:project-id (:id project)
                                         :profile-id profile-id
-                                        :role :owner})))
+                                        :role :owner})
+    project))
 
 ;; --- Mutation: Update Team
 
@@ -94,24 +104,53 @@
 
 ;; --- Mutation: Leave Team
 
+(declare role->params)
+
+(s/def ::reassign-to ::us/uuid)
 (s/def ::leave-team
-  (s/keys :req-un [::profile-id ::id]))
+  (s/keys :req-un [::profile-id ::id]
+          :opt-un [::reassign-to]))
 
 (sv/defmethod ::leave-team
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id reassign-to]}]
   (db/with-atomic [conn pool]
-    (let [perms   (teams/check-read-permissions! conn profile-id id)
+    (let [perms   (teams/get-permissions conn profile-id id)
           members (teams/retrieve-team-members conn id)]
 
-      (when (some :is-owner perms)
+      (cond
+        ;; we can only proceed if there are more members in the team
+        ;; besides the current profile
+        (<= (count members) 1)
+        (ex/raise :type :validation
+                  :code :no-enough-members-for-leave
+                  :context {:members (count members)})
+
+        ;; if the `reassign-to` is filled and has a different value
+        ;; than the current profile-id, we proceed to reassing the
+        ;; owner role to profile identified by the `reassign-to`.
+        (and reassign-to (not= reassign-to profile-id))
+        (let [member (d/seek #(= reassign-to (:id %)) members)]
+          (when-not member
+            (ex/raise :type :not-found :code :member-does-not-exist))
+
+          ;; unasign owner role to current profile
+          (db/update! conn :team-profile-rel
+                      {:is-owner false}
+                      {:team-id id
+                       :profile-id profile-id})
+
+          ;; assign owner role to new profile
+          (db/update! conn :team-profile-rel
+                      (role->params :owner)
+                      {:team-id id :profile-id reassign-to}))
+
+        ;; and finally, if all other conditions does not match and the
+        ;; current profile is owner, we dont allow it because there
+        ;; must always be an owner.
+        (:is-owner perms)
         (ex/raise :type :validation
                   :code :owner-cant-leave-team
-                  :hint "reasing owner before leave"))
-
-      (when-not (> (count members) 1)
-        (ex/raise :type :validation
-                  :code :cant-leave-team
-                  :context {:members (count members)}))
+                  :hint "releasing owner before leave"))
 
       (db/delete! conn :team-profile-rel
                   {:profile-id profile-id
@@ -119,7 +158,6 @@
 
       nil)))
 
-
 ;; --- Mutation: Delete Team
 
 (s/def ::delete-team
@@ -146,7 +184,6 @@
 ;; --- Mutation: Team Update Role
 
 (declare retrieve-team-member)
-(declare role->params)
 
 (s/def ::team-id ::us/uuid)
 (s/def ::member-id ::us/uuid)
@@ -161,8 +198,7 @@
 (sv/defmethod ::update-team-member-role
   [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
   (db/with-atomic [conn pool]
-    (let [perms   (teams/check-read-permissions! conn profile-id team-id)
-
+    (let [perms (teams/get-permissions conn profile-id team-id)
           ;; We retrieve all team members instead of query the
           ;; database for a single member. This is just for
           ;; convenience, if this bocomes a bottleneck or problematic,
@@ -170,8 +206,8 @@
           members (teams/retrieve-team-members conn team-id)
           member  (d/seek #(= member-id (:id %)) members)
 
-          is-owner? (some :is-owner perms)
-          is-admin? (some :is-admin perms)]
+          is-owner? (:is-owner perms)
+          is-admin? (:is-admin perms)]
 
       ;; If no member is found, just 404
       (when-not member
@@ -224,9 +260,9 @@
 (sv/defmethod ::delete-team-member
   [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [perms (teams/check-read-permissions! conn profile-id team-id)]
-      (when-not (or (some :is-owner perms)
-                    (some :is-admin perms))
+    (let [perms (teams/get-permissions conn profile-id team-id)]
+      (when-not (or (:is-owner perms)
+                    (:is-admin perms))
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 
@@ -251,12 +287,13 @@
   (s/keys :req-un [::profile-id ::team-id ::file]))
 
 (sv/defmethod ::update-team-photo
+  {::rlimit/permits (cf/get :rlimit-image)}
   [{:keys [pool storage] :as cfg} {:keys [profile-id file team-id] :as params}]
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
     (media/validate-media-type (:content-type file) #{"image/jpeg" "image/png" "image/webp"})
-    (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                       :mtype (:content-type file)}})
+    (media/run {:cmd :info :input {:path (:tempfile file)
+                                   :mtype (:content-type file)}})
 
     (let [team    (teams/retrieve-team conn profile-id team-id)
           storage (media/configure-assets-storage storage conn)
@@ -276,16 +313,13 @@
 
 (defn upload-photo
   [{:keys [storage] :as cfg} {:keys [file]}]
-  (let [thumb  (media/run cfg
-                 {:cmd :profile-thumbnail
-                  :format :jpeg
-                  :quality 85
-                  :width 256
-                  :height 256
-                  :input {:path (fs/path (:tempfile file))
-                          :mtype (:content-type file)}})]
-
-
+  (let [thumb (media/run {:cmd :profile-thumbnail
+                          :format :jpeg
+                          :quality 85
+                          :width 256
+                          :height 256
+                          :input {:path (fs/path (:tempfile file))
+                                  :mtype (:content-type file)}})]
     (sto/put-object storage
                     {:content (sto/content (:data thumb) (:size thumb))
                      :content-type (:mtype thumb)})))
@@ -293,28 +327,18 @@
 
 ;; --- Mutation: Invite Member
 
+(declare create-team-invitation)
+
 (s/def ::email ::us/email)
 (s/def ::invite-team-member
   (s/keys :req-un [::profile-id ::team-id ::email ::role]))
 
 (sv/defmethod ::invite-team-member
-  [{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id email role] :as params}]
   (db/with-atomic [conn pool]
     (let [perms    (teams/get-permissions conn profile-id team-id)
           profile  (db/get-by-id conn :profile profile-id)
-          member   (profile/retrieve-profile-data-by-email conn email)
-          team     (db/get-by-id conn :team team-id)
-          itoken   (tokens :generate
-                           {:iss :team-invitation
-                            :exp (dt/in-future "48h")
-                            :profile-id (:id profile)
-                            :role role
-                            :team-id team-id
-                            :member-email (:email member email)
-                            :member-id (:id member)})
-          ptoken   (tokens :generate-predefined
-                           {:iss :profile-identity
-                            :profile-id (:id profile)})]
+          team     (db/get-by-id conn :team team-id)]
 
       (when-not (:is-admin perms)
         (ex/raise :type :validation
@@ -326,24 +350,71 @@
                   :code :profile-is-muted
                   :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
 
-      (when (and member (not (eml/allow-send-emails? conn member)))
-        (ex/raise :type :validation
-                  :code :member-is-muted
-                  :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
-
-      ;; Secondly check if the invited member email is part of the
-      ;; global spam/bounce report.
-      (when (eml/has-bounce-reports? conn email)
-        (ex/raise :type :validation
-                  :code :email-has-permanent-bounces
-                  :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
-
-      (eml/send! {::eml/conn conn
-                  ::eml/factory eml/invite-to-team
-                  :public-uri (:public-uri cfg)
-                  :to email
-                  :invited-by (:fullname profile)
-                  :team (:name team)
-                  :token itoken
-                  :extra-data ptoken})
+      (create-team-invitation
+       (assoc cfg
+              :email email
+              :conn conn
+              :team team
+              :profile profile
+              :role role))
       nil)))
+
+(defn- create-team-invitation
+  [{:keys [conn tokens team profile role email] :as cfg}]
+  (let [member   (profile/retrieve-profile-data-by-email conn email)
+        itoken   (tokens :generate
+                         {:iss :team-invitation
+                          :exp (dt/in-future "48h")
+                          :profile-id (:id profile)
+                          :role role
+                          :team-id (:id team)
+                          :member-email (:email member email)
+                          :member-id (:id member)})
+        ptoken   (tokens :generate-predefined
+                         {:iss :profile-identity
+                          :profile-id (:id profile)})]
+
+    (when (and member (not (eml/allow-send-emails? conn member)))
+      (ex/raise :type :validation
+                :code :member-is-muted
+                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
+
+    ;; Secondly check if the invited member email is part of the
+    ;; global spam/bounce report.
+    (when (eml/has-bounce-reports? conn email)
+      (ex/raise :type :validation
+                :code :email-has-permanent-bounces
+                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/invite-to-team
+                :public-uri (:public-uri cfg)
+                :to email
+                :invited-by (:fullname profile)
+                :team (:name team)
+                :token itoken
+                :extra-data ptoken})))
+
+
+;; --- Mutation: Create Team & Invite Members
+
+(s/def ::emails ::us/set-of-emails)
+(s/def ::create-team-and-invite-members
+  (s/and ::create-team (s/keys :req-un [::emails ::role])))
+
+(sv/defmethod ::create-team-and-invite-members
+  [{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [team    (create-team conn params)
+          profile (db/get-by-id conn :profile profile-id)]
+
+      ;; Create invitations for all provided emails.
+      (doseq [email emails]
+        (create-team-invitation
+         (assoc cfg
+                :conn conn
+                :team team
+                :profile profile
+                :email email
+                :role role)))
+      team)))

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

@@ -34,10 +34,15 @@
   (when (profile/retrieve-profile-data-by-email conn email)
     (ex/raise :type :validation
               :code :email-already-exists))
+
   (db/update! conn :profile
               {:email email}
               {:id profile-id})
-  claims)
+
+  (with-meta claims
+    {::audit/name "update-profile-email"
+     ::audit/props {:email email}
+     ::audit/profile-id profile-id}))
 
 (defn- annotate-profile-activation
   "A helper for properly increase the profile-activation metric once the

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

@@ -37,10 +37,15 @@
 
 (sv/defmethod ::profile {:auth false}
   [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
-  (if profile-id
-    (retrieve-profile pool profile-id)
-    {:id uuid/zero
-     :fullname "Anonymous User"}))
+
+  ;; We need to return the anonymous profile object in two cases, when
+  ;; no profile-id is in session, and when db call raises not found. In all other
+  ;; cases we need to reraise the exception.
+  (or (ex/try*
+       #(some->> profile-id (retrieve-profile pool))
+       #(when (not= :not-found (:type (ex-data %))) (throw %)))
+      {:id uuid/zero
+       :fullname "Anonymous User"}))
 
 (def ^:private sql:default-profile-team
   "select t.id, name
@@ -87,13 +92,9 @@
 
 (defn retrieve-profile
   [conn id]
-  (let [profile (some->> (retrieve-profile-data conn id)
-                         (strip-private-attrs)
-                         (populate-additional-data conn))]
-    (when (nil? profile)
-      (ex/raise :type :not-found
-                :hint "Object doest not exists."))
-
+  (let [profile (->> (retrieve-profile-data conn id)
+                     (strip-private-attrs)
+                     (populate-additional-data conn))]
     (update profile :props filter-profile-props)))
 
 (def ^:private sql:profile-by-email

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

@@ -79,12 +79,14 @@
             where f.project_id = p.id
               and deleted_at is null) as count
      from project as p
+    inner join team as t on (t.id = p.team_id)
      left join team_project_profile_rel as tpp
             on (tpp.project_id = p.id and
                 tpp.team_id = p.team_id and
                 tpp.profile_id = ?)
     where p.team_id = ?
       and p.deleted_at is null
+      and t.deleted_at is null
     order by p.modified_at desc")
 
 (defn retrieve-projects
@@ -108,26 +110,26 @@
 (def sql:all-projects
   "select p1.*, t.name as team_name, t.is_default as is_default_team
      from project as p1
-    inner join team as t
-            on t.id = p1.team_id
+    inner join team as t on (t.id = p1.team_id)
     where t.id in (select team_id
                      from team_profile_rel as tpr
                     where tpr.profile_id = ?
                       and (tpr.can_edit = true or
                            tpr.is_owner = true or
                            tpr.is_admin = true))
+      and t.deleted_at is null
       and p1.deleted_at is null
    union
    select p2.*, t.name as team_name, t.is_default as is_default_team
      from project as p2
-    inner join team as t
-              on t.id = p2.team_id
+    inner join team as t on (t.id = p2.team_id)
     where p2.id in (select project_id
                      from project_profile_rel as ppr
                     where ppr.profile_id = ?
                       and (ppr.can_edit = true or
                            ppr.is_owner = true or
                            ppr.is_admin = true))
+      and t.deleted_at is null
       and p2.deleted_at is null
     order by team_name, name;")
 

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

@@ -21,8 +21,10 @@
           tpr.is_admin,
           tpr.can_edit
      from team_profile_rel as tpr
+     join team as t on (t.id = tpr.team_id)
     where tpr.profile_id = ?
-      and tpr.team_id = ?")
+      and tpr.team_id = ?
+      and t.deleted_at is null")
 
 (defn get-permissions
   [conn profile-id team-id]

backend/src/app/storage/impl.clj

@@ -117,11 +117,11 @@
       io/IOFactory
       (make-reader [_ opts]
 	    (io/make-reader path opts))
-      (make-writer [_ opts]
+      (make-writer [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       (make-input-stream [_ opts]
         (io/make-input-stream path opts))
-      (make-output-stream [_ opts]
+      (make-output-stream [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       clojure.lang.Counted
       (count [_] size)
@@ -138,11 +138,11 @@
       io/IOFactory
       (make-reader [_ opts]
 	    (io/make-reader bais opts))
-      (make-writer [_ opts]
+      (make-writer [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       (make-input-stream [_ opts]
         (io/make-input-stream bais opts))
-      (make-output-stream [_ opts]
+      (make-output-stream [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
 
       clojure.lang.Counted
@@ -159,11 +159,11 @@
     io/IOFactory
     (make-reader [_ opts]
       (io/make-reader is opts))
-    (make-writer [_ opts]
+    (make-writer [_ _]
       (throw (UnsupportedOperationException. "not implemented")))
     (make-input-stream [_ opts]
       (io/make-input-stream is opts))
-    (make-output-stream [_ opts]
+    (make-output-stream [_ _]
       (throw (UnsupportedOperationException. "not implemented")))
 
     clojure.lang.Counted

backend/src/app/tasks/telemetry.clj

@@ -59,7 +59,7 @@
         response    (http/send! {:method :post
                                  :uri (:uri cfg)
                                  :headers {"content-type" "application/json"}
-                                 :body (json/encode-str data)})]
+                                 :body (json/write-str data)})]
     (when (> (:status response) 206)
       (ex/raise :type :internal
                 :code :invalid-response

backend/src/app/util/emails.clj

@@ -6,7 +6,6 @@
 
 (ns app.util.emails
   (:require
-   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.util.template :as tmpl]
@@ -199,7 +198,7 @@
       (ex/raise :type :internal
                 :code :missing-email-templates))
     {:subject subj
-     :body (d/concat
+     :body (into
             [{:type "text/plain"
               :content text}]
             (when html

backend/src/app/util/json.clj

@@ -9,22 +9,27 @@
   (:require
    [jsonista.core :as j]))
 
-(defn encode-str
-  [v]
-  (j/write-value-as-string v j/keyword-keys-object-mapper))
+(defn mapper
+  [params]
+  (j/object-mapper params))
+
+(defn write
+  ([v] (j/write-value-as-bytes v j/keyword-keys-object-mapper))
+  ([v mapper] (j/write-value-as-bytes v mapper)))
+
+(defn write-str
+  ([v] (j/write-value-as-string v j/keyword-keys-object-mapper))
+  ([v mapper] (j/write-value-as-string v mapper)))
+
+(defn read
+  ([v] (j/read-value v j/keyword-keys-object-mapper))
+  ([v mapper] (j/read-value v mapper)))
 
 (defn encode
   [v]
   (j/write-value-as-bytes v j/keyword-keys-object-mapper))
 
-(defn decode-str
-  [v]
-  (j/read-value v j/keyword-keys-object-mapper))
-
 (defn decode
   [v]
   (j/read-value v j/keyword-keys-object-mapper))
 
-(defn read
-  [v]
-  (j/read-value v j/keyword-keys-object-mapper))

backend/src/app/util/retry.clj

@@ -0,0 +1,43 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.util.retry
+  "A fault tolerance helpers. Allow retry some operations that we know
+  we can retry."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.util.async :as aa]
+   [app.util.services :as sv]))
+
+(defn conflict-db-insert?
+  "Check if exception matches a insertion conflict on postgresql."
+  [e]
+  (and (instance? org.postgresql.util.PSQLException e)
+       (= "23505" (.getSQLState e))))
+
+(defn wrap-retry
+  [_ f {:keys [::max-retries ::matches ::sv/name]
+        :or {max-retries 3
+             matches (constantly false)}
+        :as mdata}]
+  (when (::enabled mdata)
+    (l/debug :hint "wrapping retry" :name name))
+  (if (::enabled mdata)
+    (fn [cfg params]
+      (loop [retry 1]
+        (when (> retry 1)
+          (l/debug :hint "retrying controlled function" :retry retry :name name))
+        (let [res (ex/try (f cfg params))]
+          (if (ex/exception? res)
+            (if (and (matches res) (< retry max-retries))
+              (do
+                (aa/thread-sleep (* 100 retry))
+                (recur (inc retry)))
+              (throw res))
+            res))))
+    f))
+

backend/src/app/util/rlimit.clj

@@ -0,0 +1,36 @@
+;; 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.util.rlimit
+  "Resource usage limits (in other words: semaphores)."
+  (:require
+   [app.common.logging :as l]
+   [app.util.services :as sv])
+  (:import
+   java.util.concurrent.Semaphore))
+
+(defn acquire!
+  [sem]
+  (.acquire ^Semaphore sem))
+
+(defn release!
+  [sem]
+  (.release ^Semaphore sem))
+
+(defn wrap-rlimit
+  [_cfg f mdata]
+  (if-let [permits (::permits mdata)]
+    (let [sem (Semaphore. permits)]
+      (l/debug :hint "wrapping rlimit" :handler (::sv/name mdata) :permits permits)
+      (fn [cfg params]
+        (try
+          (acquire! sem)
+          (f cfg params)
+          (finally
+            (release! sem)))))
+    f))
+
+

backend/src/app/worker.clj

@@ -266,13 +266,8 @@
 
         (= ::noop (:strategy edata))
         (assoc :inc-by 0))
-
-      (let [cdata (get-error-context error item)]
-        (l/update-thread-context! cdata)
-        (l/error :cause error
-                 :hint "unhandled exception on task"
-                 :id (:id cdata))
-
+      (l/with-context (get-error-context error item)
+        (l/error :cause error :hint "unhandled exception on task")
         (if (>= (:retry-num item) (:max-retries item))
           {:status :failed :task item :error error}
           {:status :retry :task item :error error})))))

backend/test/app/services_media_test.clj

@@ -86,3 +86,48 @@
         (t/is (= 312043 (:size mobj1)))
         (t/is (= 3887   (:size mobj2)))))
     ))
+
+
+(t/deftest media-object-upload-idempotency
+  (let [prof   (th/create-profile* 1)
+        proj   (th/create-project* 1 {:profile-id (:id prof)
+                                      :team-id (:default-team-id prof)})
+        file   (th/create-file* 1 {:profile-id (:id prof)
+                                   :project-id (:default-project-id prof)
+                                   :is-shared false})
+        mfile  {:filename "sample.jpg"
+                :tempfile (th/tempfile "app/test_files/sample.jpg")
+                :content-type "image/jpeg"
+                :size 312043}
+
+        params {::th/type :upload-file-media-object
+                :profile-id (:id prof)
+                :file-id (:id file)
+                :is-local true
+                :name "testfile"
+                :content mfile
+                :id (uuid/next)}]
+
+    ;; First try
+    (let [{:keys [result error] :as out} (th/mutation! params)]
+      ;; (th/print-result! out)
+      (t/is (nil? error))
+      (t/is (= (:id params) (:id result)))
+      (t/is (= (:file-id params) (:file-id result)))
+      (t/is (= 800 (:width result)))
+      (t/is (= 800 (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? (:media-id result)))
+      (t/is (uuid? (:thumbnail-id result))))
+
+    ;; Second try
+    (let [{:keys [result error] :as out} (th/mutation! params)]
+      ;; (th/print-result! out)
+      (t/is (nil? error))
+      (t/is (= (:id params) (:id result)))
+      (t/is (= (:file-id params) (:file-id result)))
+      (t/is (= 800 (:width result)))
+      (t/is (= 800 (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? (:media-id result)))
+      (t/is (uuid? (:thumbnail-id result))))))

backend/test/app/services_profile_test.clj

@@ -6,6 +6,7 @@
 
 (ns app.services-profile-test
   (:require
+   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.mutations.profile :as profile]
    [app.test-helpers :as th]
@@ -153,11 +154,8 @@
                   :profile-id (:id prof)}
           out    (th/query! params)]
       ;; (th/print-result! out)
-      (let [error (:error out)
-            error-data (ex-data error)]
-        (t/is (th/ex-info? error))
-        (t/is (= (:type error-data) :not-found))))
-    ))
+      (let [result (:result out)]
+        (t/is (= uuid/zero (:id result)))))))
 
 (t/deftest registration-domain-whitelist
   (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]

backend/test/app/services_projects_test.clj

@@ -43,7 +43,7 @@
 
       (t/is (nil? (:error out)))
       (let [result (:result out)]
-        (t/is (= 1 (count result)))
+        (t/is (= 2 (count result)))
         (t/is project-id (get-in result [0 :id]))
         (t/is (= "test project" (get-in result [0 :name])))))
 
@@ -55,15 +55,15 @@
 
       (t/is (nil? (:error out)))
       (let [result (:result out)]
-        (t/is (= 2 (count result)))
+        (t/is (= 3 (count result)))
         (t/is (not= project-id (get-in result [0 :id])))
         (t/is (= "Drafts" (get-in result [0 :name])))
         (t/is (= "Default" (get-in result [0 :team-name])))
         (t/is (= true (get-in result [0 :is-default-team])))
-        (t/is project-id (get-in result [1 :id]))
-        (t/is (= "test project" (get-in result [1 :name])))
-        (t/is (= "team1" (get-in result [1 :team-name])))
-        (t/is (= false (get-in result [1 :is-default-team])))))
+        (t/is project-id (get-in result [2 :id]))
+        (t/is (= "test project" (get-in result [2 :name])))
+        (t/is (= "team1" (get-in result [2 :team-name])))
+        (t/is (= false (get-in result [2 :is-default-team])))))
 
     ;; rename project
     (let [data {::th/type :rename-project
@@ -95,7 +95,7 @@
       (t/is (nil? (:error out)))
       (t/is (nil? (:result out))))
 
-    ;; query a list of projects after delete"
+    ;; query a list of projects after delete
     (let [data {::th/type :projects
                 :team-id (:id team)
                 :profile-id (:id profile)}
@@ -103,7 +103,7 @@
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (let [result (:result out)]
-        (t/is (= 0 (count result)))))
+        (t/is (= 1 (count result)))))
   ))
 
 (t/deftest permissions-checks-create-project

backend/test/app/services_teams_test.clj

@@ -33,7 +33,6 @@
                     :role :editor
                     :profile-id (:id profile1)}]
 
-
       ;; invite external user without complaints
       (let [data (assoc data :email "foo@bar.com")
             out  (th/mutation! data)]
@@ -130,15 +129,16 @@
     (let [result (task {:max-age (dt/duration {:minutes 1})})]
       (t/is (nil? result)))
 
-    ;; query the list of projects of a after hard deletion
+    ;; query the list of projects after hard deletion
     (let [data {::th/type :projects
                 :team-id (:id team)
                 :profile-id (:id profile1)}
           out  (th/query! data)]
       ;; (th/print-result! out)
-      (t/is (nil? (:error out)))
-      (let [result (:result out)]
-        (t/is (= 0 (count result)))))
+      (let [error (:error out)
+            error-data (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type error-data) :not-found))))
 
     ;; run permanent deletion
     (let [result (task {:max-age (dt/duration 0)})]

backend/test/app/test_helpers.clj

@@ -126,7 +126,8 @@
                         :password "123123"
                         :is-demo false}
                        params)]
-     (->> (#'profile/create-profile conn params)
+     (->> params
+          (#'profile/create-profile conn)
           (#'profile/create-profile-relations conn)))))
 
 (defn create-project*
@@ -159,15 +160,10 @@
   ([i params] (create-team* *pool* i params))
   ([conn i {:keys [profile-id] :as params}]
    (us/assert uuid? profile-id)
-   (let [id   (mk-uuid "team" i)
-         team (#'teams/create-team conn {:id id
-                                         :profile-id profile-id
-                                         :name (str "team" i)})]
-     (#'teams/create-team-role conn
-                               {:team-id id
-                                :profile-id profile-id
-                                :role :owner})
-     team)))
+   (let [id   (mk-uuid "team" i)]
+     (teams/create-team conn {:id id
+                              :profile-id profile-id
+                              :name (str "team" i)}))))
 
 (defn create-file-media-object*
   ([params] (create-file-media-object* *pool* params))
@@ -350,3 +346,11 @@
 (defn reset-mock!
   [m]
   (reset! m @(mk/make-mock {})))
+
+(defn pause
+  []
+  (let [^java.io.Console cnsl (System/console)]
+    (println "[waiting RETURN]")
+    (.readLine cnsl)
+    nil))
+

common/deps.edn

@@ -1,18 +1,17 @@
 {:deps
  {org.clojure/clojure {:mvn/version "1.10.3"}
   org.clojure/data.json {:mvn/version "2.3.1"}
-  org.clojure/core.async {:mvn/version "1.3.618"}
   org.clojure/tools.cli {:mvn/version "1.0.206"}
   metosin/jsonista {:mvn/version "0.3.3"}
   org.clojure/clojurescript {:mvn/version "1.10.844"}
 
   ;; Logging
-  org.clojure/tools.logging {:mvn/version "1.1.0"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.14.1"}
+  org.clojure/tools.logging {:mvn/version "1.2.3"}
+  org.apache.logging.log4j/log4j-api {:mvn/version "2.17.0"}
+  org.apache.logging.log4j/log4j-core {:mvn/version "2.17.0"}
+  org.apache.logging.log4j/log4j-web {:mvn/version "2.17.0"}
+  org.apache.logging.log4j/log4j-jul {:mvn/version "2.17.0"}
+  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.17.0"}
   org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
 
   selmer/selmer {:mvn/version "1.12.40"}
@@ -33,7 +32,8 @@
   com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
 
   ;; exception printing
-  io.aviso/pretty {:mvn/version "0.1.37"}
+  fipp/fipp {:mvn/version "0.6.24"}
+  io.aviso/pretty {:mvn/version "1.1.1"}
   environ/environ {:mvn/version "1.2.0"}}
  :paths ["src"]
  :aliases

common/dev/user.clj

@@ -37,7 +37,7 @@
 ;; --- Development Stuff
 
 (defn- run-tests
-  ([] (run-tests #"^app.common.tests.*"))
+  ([] (run-tests #"^app.common.*-test$"))
   ([o]
    (repl/refresh)
    (cond

common/src/app/common/data.cljc

@@ -6,7 +6,7 @@
 
 (ns app.common.data
   "Data manipulation and query helper functions."
-  (:refer-clojure :exclude [concat read-string hash-map merge name])
+  (:refer-clojure :exclude [read-string hash-map merge name parse-double])
   #?(:cljs
      (:require-macros [app.common.data]))
   (:require
@@ -60,19 +60,37 @@
       m)
     (dissoc m k)))
 
-(defn concat
-  [& colls]
-  (loop [result (transient (first colls))
-         colls  (next colls)]
+(defn- transient-concat
+  [c1 colls]
+  (loop [result (transient c1)
+         colls  colls]
     (if colls
       (recur (reduce conj! result (first colls))
              (next colls))
       (persistent! result))))
 
+(defn concat-set
+  ([] #{})
+  ([c1]
+   (if (set? c1) c1 (into #{} c1)))
+  ([c1 & more]
+   (if (set? c1)
+     (transient-concat c1 more)
+     (transient-concat #{} (cons c1 more)))))
+
+(defn concat-vec
+  ([] [])
+  ([c1]
+   (if (vector? c1) c1 (into [] c1)))
+  ([c1 & more]
+   (if (vector? c1)
+     (transient-concat c1 more)
+     (transient-concat [] (cons c1 more)))))
+
 (defn preconj
   [coll elem]
   (assert (vector? coll))
-  (concat [elem] coll))
+  (into [elem] coll))
 
 (defn enumerate
   ([items] (enumerate items 0))
@@ -144,10 +162,15 @@
      (reduce #(dissoc! %1 %2) (transient data) keys))))
 
 (defn remove-at-index
+  "Takes a vector and returns a vector with an element in the
+  specified index removed."
   [v index]
-  (vec (core/concat
-        (subvec v 0 index)
-        (subvec v (inc index)))))
+  ;; The subvec function returns a SubVector type that is an vector
+  ;; but does not have transient impl, because of this, we need to
+  ;; pass an explicit vector as first argument.
+  (concat-vec []
+              (subvec v 0 index)
+              (subvec v (inc index))))
 
 (defn zip [col1 col2]
   (map vector col1 col2))
@@ -229,6 +252,11 @@
   #?(:clj (Object.)
      :cljs (js/Object.)))
 
+(defn getf
+  "Returns a function to access a map"
+  [coll]
+  (partial get coll))
+
 (defn update-in-when
   [m key-seq f & args]
   (let [found (get-in m key-seq sentinel)]
@@ -433,18 +461,18 @@
          (str maybe-keyword)))))
 
 (defn with-next
-  "Given a collectin will return a new collection where each element
-  is paried with the next item in the collection
-  (with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]"
+  "Given a collection will return a new collection where each element
+  is paired with the next item in the collection
+  (with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]]"
   [coll]
   (map vector
        coll
-       (concat [] (rest coll) [nil])))
+       (concat (rest coll) [nil])))
 
 (defn with-prev
-  "Given a collectin will return a new collection where each element
-  is paried with the previous item in the collection
-  (with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]"
+  "Given a collection will return a new collection where each element
+  is paired with the previous item in the collection
+  (with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]]"
   [coll]
   (map vector
        coll
@@ -453,12 +481,12 @@
 (defn with-prev-next
   "Given a collection will return a new collection where every item is paired
   with the previous and the next item of a collection
-  (with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]"
+  (with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]]"
   [coll]
   (map vector
        coll
        (concat [nil] coll)
-       (concat [] (rest coll) [nil])))
+       (concat (rest coll) [nil])))
 
 (defn prefix-keyword
   "Given a keyword and a prefix will return a new keyword with the prefix attached

common/src/app/common/file_builder.cljc

@@ -392,7 +392,8 @@
 
 (defmethod read-action-opts :navigate
   [interaction-src]
-  (select-keys interaction-src [:destination]))
+  (select-keys interaction-src [:destination
+                                :preserve-scroll]))
 
 (defmethod read-action-opts :open-overlay
   [interaction-src]
@@ -430,7 +431,8 @@
   (let [{:keys [event-type action-type]} (read-classifier interaction-src)
         {:keys [delay]} (read-event-opts interaction-src)
         {:keys [destination overlay-pos-type overlay-position url
-                close-click-outside background-overlay]} (read-action-opts interaction-src)
+                close-click-outside background-overlay preserve-scroll]}
+        (read-action-opts interaction-src)
 
         interactions (-> (lookup-shape file from-id)
                          :interactions
@@ -443,7 +445,8 @@
                                            :overlay-position overlay-position
                                            :url url
                                            :close-click-outside close-click-outside
-                                           :background-overlay background-overlay})))]
+                                           :background-overlay background-overlay
+                                           :preserve-scroll preserve-scroll})))]
     (commit-change
      file
      {:type :mod-obj

common/src/app/common/flags.cljc

@@ -10,30 +10,28 @@
    [cuerdas.core :as str]))
 
 (def default
-  #{:backend-asserts
-    :api-doc
-    :registration
-    :demo-users})
+  "A common flags that affects both: backend and frontend."
+  [:enable-registration
+   :enable-demo-users])
 
 (defn parse
-  ([flags] (parse flags #{}))
-  ([flags default]
-   (loop [flags  (seq flags)
-          result default]
-     (let [item (first flags)]
-       (if (nil? item)
-         result
-         (let [sname (name item)]
-           (cond
-             (str/starts-with? sname "enable-")
-             (recur (rest flags)
-                    (conj result (keyword (subs sname 7))))
+  [& flags]
+  (loop [flags  (apply concat flags)
+         result #{}]
+    (let [item (first flags)]
+      (if (nil? item)
+        result
+        (let [sname (name item)]
+          (cond
+            (str/starts-with? sname "enable-")
+            (recur (rest flags)
+                   (conj result (keyword (subs sname 7))))
 
-             (str/starts-with? sname "disable-")
-             (recur (rest flags)
-                    (disj result (keyword (subs sname 8))))
+            (str/starts-with? sname "disable-")
+            (recur (rest flags)
+                   (disj result (keyword (subs sname 8))))
 
-             :else
-             (recur (rest flags) result))))))))
+            :else
+            (recur (rest flags) result)))))))
 
 

common/src/app/common/geom/align.cljc

@@ -6,7 +6,6 @@
 
 (ns app.common.geom.align
   (:require
-   [app.common.data :as d]
    [app.common.geom.shapes :as gsh]
    [clojure.spec.alpha :as s]))
 
@@ -16,11 +15,15 @@
 
 (declare calc-align-pos)
 
+;; TODO: revisit on how to reuse code and dont have this function
+;; duplicated because the implementation right now differs from the
+;; original function.
+
 ;; Duplicated from pages/helpers to remove cyclic dependencies
 (defn- get-children [id objects]
   (let [shapes (vec (get-in objects [id :shapes]))]
     (if shapes
-      (d/concat shapes (mapcat #(get-children % objects) shapes))
+      (into shapes (mapcat #(get-children % objects)) shapes)
       [])))
 
 (defn- recursive-move

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

@@ -6,6 +6,7 @@
 
 (ns app.common.geom.shapes.intersect
   (:require
+   [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.path :as gpp]
@@ -172,22 +173,23 @@
   "Checks if the given rect overlaps with the path in any point"
   [shape 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)
+  (when (d/not-empty? (:content shape))
+    (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   (if simple?
-                       (points->lines (:points shape))
-                       (gpp/path->lines shape))
-        start-point (-> shape :content (first) :params (gpt/point))]
+          rect-points  (gpr/rect->points rect)
+          rect-lines   (points->lines rect-points)
+          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)
-        (is-point-inside-nonzero? start-point rect-lines)
-        (intersects-lines? rect-lines path-lines))))
+      (or (is-point-inside-nonzero? (first rect-points) path-lines)
+          (is-point-inside-nonzero? start-point rect-lines)
+          (intersects-lines? rect-lines path-lines)))))
 
 (defn is-point-inside-ellipse?
   "checks if a point is inside an ellipse"

common/src/app/common/geom/shapes/path.cljc

@@ -100,7 +100,7 @@
 (defn curve-tangent
   "Retrieve the tangent vector to the curve in the point `t`"
   [[start end h1 h2] t]
-  
+
   (let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
                 [(:y start) (:y h1) (:y h2) (:y end)]]
 
@@ -316,15 +316,13 @@
                   :line-to [prev-point (command->point command)]
 
                   ;; We return the bezier extremities
-                  :curve-to (d/concat
-                             [prev-point
-                              (command->point command)]
-                             (let [curve [prev-point
-                                          (command->point command)
-                                          (command->point command :c1)
-                                          (command->point command :c2)]]
-                               (->> (curve-extremities curve)
-                                    (mapv #(curve-values curve %)))))
+                  :curve-to (into [prev-point (command->point command)]
+                                  (let [curve [prev-point
+                                               (command->point command)
+                                               (command->point command :c1)
+                                               (command->point command :c2)]]
+                                    (->> (curve-extremities curve)
+                                         (map #(curve-values curve %)))))
                   [])
          selrect (gpr/points->selrect points)]
      (-> selrect
@@ -342,20 +340,19 @@
                       (command->point command)]
 
             ;; We return the bezier extremities
-            :curve-to (d/concat
-                       [(command->point prev)
-                        (command->point command)]
-                       (let [curve [(command->point prev)
-                                    (command->point command)
-                                    (command->point command :c1)
-                                    (command->point command :c2)]]
-                         (->> (curve-extremities curve)
-                              (mapv #(curve-values curve %)))))
+            :curve-to (into [(command->point prev)
+                             (command->point command)]
+                            (let [curve [(command->point prev)
+                                         (command->point command)
+                                         (command->point command :c1)
+                                         (command->point command :c2)]]
+                              (->> (curve-extremities curve)
+                                   (map #(curve-values curve %)))))
             []))
 
         extremities (mapcat calc-extremities
                             content
-                            (d/concat [nil] content))
+                            (concat [nil] content))
 
         selrect (gpr/points->selrect extremities)]
 
@@ -410,14 +407,16 @@
    (let [initial (first segments)
          lines (rest segments)]
 
-     (d/concat [{:command :move-to
-                 :params (select-keys initial [:x :y])}]
-               (->> lines
-                    (mapv #(hash-map :command :line-to
-                                     :params (select-keys % [:x :y]))))
+     (d/concat-vec
+      [{:command :move-to
+        :params (select-keys initial [:x :y])}]
 
-               (when closed?
-                 [{:command :close-path}])))))
+      (->> lines
+           (map #(hash-map :command :line-to
+                           :params (select-keys % [:x :y]))))
+
+      (when closed?
+        [{:command :close-path}])))))
 
 (defonce num-segments 10)
 
@@ -770,7 +769,7 @@
                           ts-3 (check-range c1-half c1-to c2-from c2-half)
                           ts-4 (check-range c1-half c1-to c2-half c2-to)]
 
-                      (d/concat [] ts-1 ts-2 ts-3 ts-4)))))))
+                      (d/concat-vec ts-1 ts-2 ts-3 ts-4)))))))
 
           (remove-close-ts [{cp1 :p1 cp2 :p2}]
             (fn [{:keys [p1 p2]}]

common/src/app/common/logging.cljc

@@ -9,16 +9,23 @@
    [app.common.exceptions :as ex]
    [clojure.pprint :refer [pprint]]
    [cuerdas.core :as str]
+   #?(:clj [io.aviso.exception :as ie])
    #?(:cljs [goog.log :as glog]))
-  #?(:cljs (:require-macros [app.common.logging]))
-  #?(:clj
-     (:import
-      org.apache.logging.log4j.Level
-      org.apache.logging.log4j.LogManager
-      org.apache.logging.log4j.Logger
-      org.apache.logging.log4j.ThreadContext
-      org.apache.logging.log4j.message.MapMessage
-      org.apache.logging.log4j.spi.LoggerContext)))
+  #?(:cljs (:require-macros [app.common.logging])
+     :clj  (:import
+            org.apache.logging.log4j.Level
+            org.apache.logging.log4j.LogManager
+            org.apache.logging.log4j.Logger
+            org.apache.logging.log4j.ThreadContext
+            org.apache.logging.log4j.CloseableThreadContext
+            org.apache.logging.log4j.message.MapMessage
+            org.apache.logging.log4j.spi.LoggerContext)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CLJ Specific
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:clj (set! *warn-on-reflection* true))
 
 #?(:clj
    (defn build-map-message
@@ -34,17 +41,75 @@
   (def logging-agent
     (agent nil :error-mode :continue)))
 
+(defn- simple-prune
+  ([s] (simple-prune s (* 1024 1024)))
+  ([s max-length]
+   (if (> (count s) max-length)
+     (str (subs s 0 max-length) " [...]")
+     s)))
+
+#?(:clj
+   (defn stringify-data
+     [val]
+     (cond
+       (instance? clojure.lang.Named val)
+       (name val)
+
+       (instance? Throwable val)
+       (binding [ie/*app-frame-names* [#"app.*"]
+                 ie/*fonts* nil
+                 ie/*traditional* true]
+         (ie/format-exception val nil))
+
+       (string? val)
+       val
+
+       (coll? val)
+       (binding [clojure.pprint/*print-right-margin* 200]
+         (-> (with-out-str (pprint val))
+             (simple-prune (* 1024 1024 3))))
+
+       :else
+       (str val))))
+
+#?(:clj
+   (defn data->context-map
+     ^java.util.Map
+     [data]
+     (into {}
+           (comp (filter second)
+                 (map (fn [[key val]]
+                        [(stringify-data key)
+                         (stringify-data val)])))
+           data)))
+
+#?(:clj
+   (defn set-context!
+     [data]
+     (ThreadContext/putAll (data->context-map data))
+     nil))
+
+#?(:clj
+   (defmacro with-context
+     [data & body]
+     `(let [data# (data->context-map ~data)]
+        (with-open [closeable# (CloseableThreadContext/putAll data#)]
+          ~@body))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Common
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn get-logger
   [lname]
   #?(:clj  (.getLogger ^LoggerContext logger-context ^String lname)
-     :cljs
-      (glog/getLogger
-       (cond
-         (string? lname) lname
-         (= lname :root) ""
-         (simple-ident? lname) (name lname)
-         (qualified-ident? lname) (str (namespace lname) "." (name lname))
-         :else (str lname)))))
+     :cljs (glog/getLogger
+            (cond
+              (string? lname) lname
+              (= lname :root) ""
+              (simple-ident? lname) (name lname)
+              (qualified-ident? lname) (str (namespace lname) "." (name lname))
+              :else (str lname)))))
 
 (defn get-level
   [level]
@@ -87,7 +152,7 @@
      :cljs
      (when glog/ENABLED
        (when-let [l (get-logger logger)]
-         (let [level  (get-level level)
+         (let [level (get-level level)
                record (glog/LogRecord. level message (.getName ^js l))]
            (when exception (.setException record exception))
            (glog/publishLogRecord l record))))))
@@ -98,7 +163,7 @@
      (.isEnabled ^Logger logger ^Level level)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async ::raw] :as props}]
+  [& {:keys [level cause ::logger ::async ::raw] :or {async true} :as props}]
   (if (:ns &env) ; CLJS
     `(write-log! ~(or logger (str *ns*))
                  ~level
@@ -112,10 +177,12 @@
              ~level-sym  (get-level ~level)]
          (if (enabled? ~logger-sym ~level-sym)
            ~(if async
-              `(send-off logging-agent
-                         (fn [_#]
-                           (let [message# (or ~raw (build-map-message ~props))]
-                             (write-log! ~logger-sym ~level-sym ~cause message#))))
+              `(let [cdata# (ThreadContext/getImmutableContext)]
+                 (send-off logging-agent
+                           (fn [_#]
+                             (with-context (into {:cause ~cause} cdata#)
+                               (->> (or ~raw (build-map-message ~props))
+                                    (write-log! ~logger-sym ~level-sym ~cause))))))
               `(let [message# (or ~raw (build-map-message ~props))]
                  (write-log! ~logger-sym ~level-sym ~cause message#))))))))
 
@@ -147,24 +214,6 @@
    (when (:ns &env)
      `(set-level* ~n ~level))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; CLJ Specific
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#?(:clj
-   (defn update-thread-context!
-     [data]
-     (run! (fn [[key val]]
-             (ThreadContext/put
-              (name key)
-              (cond
-                (coll? val)
-                (binding [clojure.pprint/*print-right-margin* 120]
-                  (with-out-str (pprint val)))
-                (instance? clojure.lang.Named val) (name val)
-                :else (str val))))
-           data)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CLJS Specific
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -213,7 +262,6 @@
      (some-> (get-logger name)
              (glog/setLevel (get-level lvl)))))
 
-
 #?(:cljs
    (defn set-levels!
      [lvls]

common/src/app/common/pages/changes.cljc

@@ -195,7 +195,8 @@
   [data {:keys [parent-id shapes index page-id component-id ignore-touched]}]
   (letfn [(is-valid-move? [objects shape-id]
             (let [invalid-targets (cph/calculate-invalid-targets shape-id objects)]
-              (and (not (invalid-targets parent-id))
+              (and (contains? objects shape-id)
+                   (not (invalid-targets parent-id))
                    (cph/valid-frame-target shape-id parent-id objects))))
 
           (insert-items [prev-shapes index shapes]
@@ -214,7 +215,7 @@
                     not-mask-shapes (without-obj shapes mask-id)
                     new-index       (if (nil? index) nil (max (dec index) 0))
                     new-shapes      (insert-items other-ids new-index not-mask-shapes)]
-                (d/concat [mask-id] new-shapes))))
+                (into [mask-id] new-shapes))))
 
           (add-to-parent [parent index shapes]
             (let [parent (-> parent

common/src/app/common/pages/changes_builder.cljc

@@ -97,7 +97,7 @@
            (let [old-obj (get objects id)
                  new-obj (update-fn old-obj)
 
-                 attrs (or attrs (d/concat #{} (keys old-obj) (keys new-obj)))
+                 attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
 
                  {rops :rops uops :uops}
                  (reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)

common/src/app/common/pages/common.cljc

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

common/src/app/common/pages/helpers.cljc

@@ -103,7 +103,6 @@
   "Retrieve all children ids recursively for a given object. The
   children's order will be breadth first."
   [id objects]
-
   (loop [result  (transient [])
          pending (transient [])
          next    id]
@@ -214,10 +213,10 @@
   [objects index ids]
   (let [[before after] (split-at index objects)
         p? (set ids)]
-    (d/concat []
-              (remove p? before)
-              ids
-              (remove p? after))))
+    (d/concat-vec []
+                  (remove p? before)
+                  ids
+                  (remove p? after))))
 
 (defn append-at-the-end
   [prev-ids ids]
@@ -233,43 +232,36 @@
   ([objects {:keys [include-frames? include-frame-children?]
              :or {include-frames? false
                   include-frame-children? true}}]
-   (let [lookup #(get objects %)
-         root   (lookup uuid/zero)
+
+   (let [lookup        #(get objects %)
+         root          (lookup uuid/zero)
          root-children (:shapes root)
 
          lookup-shapes
          (fn [result id]
            (if (nil? id)
              result
-             (let [obj (lookup id)
-                   typ (:type obj)
+             (let [obj      (lookup id)
+                   typ      (:type obj)
                    children (:shapes obj)]
 
                (cond-> result
                  (or (not= :frame typ) include-frames?)
-                 (d/concat [obj])
+                 (conj obj)
 
                  (and (= :frame typ) include-frame-children?)
-                 (d/concat (map lookup children))))))]
+                 (into (map lookup) children)))))]
 
      (reduce lookup-shapes [] root-children))))
 
 (defn select-frames
   [objects]
-  (let [root   (get objects uuid/zero)
-        loopfn (fn loopfn [ids]
-                 (let [id (first ids)
-                       obj (get objects id)]
-                   (cond
-                     (or (nil? id) (nil? obj))
-                     nil
-
-                     (= :frame (:type obj))
-                     (lazy-seq (cons obj (loopfn (rest ids))))
-
-                     :else
-                     (lazy-seq (loopfn (rest ids))))))]
-    (loopfn (:shapes root))))
+  (let [lookup #(get objects %)
+        frame? #(= :frame (:type %))
+        xform  (comp (map lookup)
+                     (filter frame?))]
+    (->> (:shapes (lookup uuid/zero))
+         (into [] xform))))
 
 (defn clone-object
   "Gets a copy of the object and all its children, with new ids
@@ -299,15 +291,13 @@
                             (some? (:shapes object))
                             (assoc :shapes (mapv :id new-direct-children)))
 
-               new-object (update-new-object new-object object)
-
-               new-objects (d/concat [new-object] new-children)
-
-               updated-object (update-original-object object new-object)
+               new-object  (update-new-object new-object object)
+               new-objects (into [new-object] new-children)
 
+               updated-object  (update-original-object object new-object)
                updated-objects (if (identical? object updated-object)
                                  updated-children
-                                 (d/concat [updated-object] updated-children))]
+                                 (into [updated-object] updated-children))]
 
            [new-object new-objects updated-objects])
 
@@ -320,9 +310,9 @@
 
            (recur
             (next child-ids)
-            (d/concat new-direct-children [new-child])
-            (d/concat new-children new-child-objects)
-            (d/concat updated-children updated-child-objects))))))))
+            (into new-direct-children [new-child])
+            (into new-children new-child-objects)
+            (into updated-children updated-child-objects))))))))
 
 (defn indexed-shapes
   "Retrieves a list with the indexes for each element in the layer tree.
@@ -438,7 +428,7 @@
   [path-name]
   (let [path-name-split (split-path path-name)
         path (str/join " / " (butlast path-name-split))
-        name (last path-name-split)]
+        name (or (last path-name-split) "")]
     [path name]))
 
 (defn merge-path-item

common/src/app/common/pages/indices.cljc

@@ -12,28 +12,25 @@
    [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])))
+  (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]) [])]
+        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])
+        (let [children  (get-in objects [current :shapes])
               is-frame? (is-frame? current)
-              pending (if (not is-frame?)
-                        (d/concat pending children)
-                        pending)]
+              pending   (if (not is-frame?)
+                          (d/concat-vec pending children)
+                          pending)]
 
           (if (empty? pending)
-            (-> z-index
-                (assoc current current-idx))
-
+            (assoc z-index current current-idx)
             (recur (peek pending)
                    (pop pending)
                    (dec current-idx)

common/src/app/common/pages/migrations.cljc

@@ -268,3 +268,16 @@
             (update page :objects #(d/mapm (partial update-object %) %)))]
 
     (update data :pages-index #(d/mapm update-page %))))
+
+
+(defmethod migrate 12
+  [data]
+  (letfn [(update-grid [_key grid]
+            (cond-> grid
+              (= :auto (:size grid))
+              (assoc :size nil)))
+
+          (update-page [_id page]
+            (d/update-in-when page [:options :saved-grids] #(d/mapm update-grid %)))]
+
+    (update data :pages-index #(d/mapm update-page %))))

common/src/app/common/pages/spec.cljc

@@ -11,6 +11,7 @@
    [app.common.spec :as us]
    [app.common.types.interactions :as cti]
    [app.common.types.page-options :as cto]
+   [app.common.types.radius :as ctr]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
    [clojure.spec.alpha :as s]))
@@ -191,12 +192,6 @@
 (s/def :internal.shape/page-id uuid?)
 (s/def :internal.shape/proportion ::us/safe-number)
 (s/def :internal.shape/proportion-lock boolean?)
-(s/def :internal.shape/rx ::us/safe-number)
-(s/def :internal.shape/ry ::us/safe-number)
-(s/def :internal.shape/r1 ::us/safe-number)
-(s/def :internal.shape/r2 ::us/safe-number)
-(s/def :internal.shape/r3 ::us/safe-number)
-(s/def :internal.shape/r4 ::us/safe-number)
 (s/def :internal.shape/stroke-color string?)
 (s/def :internal.shape/stroke-color-gradient (s/nilable ::gradient))
 (s/def :internal.shape/stroke-color-ref-file (s/nilable uuid?))
@@ -285,12 +280,12 @@
                    :internal.shape/constraints-h
                    :internal.shape/constraints-v
                    :internal.shape/fixed-scroll
-                   :internal.shape/rx
-                   :internal.shape/ry
-                   :internal.shape/r1
-                   :internal.shape/r2
-                   :internal.shape/r3
-                   :internal.shape/r4
+                   ::ctr/rx
+                   ::ctr/ry
+                   ::ctr/r1
+                   ::ctr/r2
+                   ::ctr/r3
+                   ::ctr/r4
                    :internal.shape/x
                    :internal.shape/y
                    :internal.shape/exports

common/src/app/common/path/bool.cljc

@@ -42,7 +42,8 @@
       (let [head-p (gsp/command->point head)
             head (cond
                    (and (= :close-path (:command head))
-                        (< (gpt/distance last-p last-move) 0.01))
+                        (or (nil? last-p) ;; Ignore consecutive close-paths
+                            (< (gpt/distance last-p last-move) 0.01)))
                    nil
 
                    (= :close-path (:command head))
@@ -212,26 +213,25 @@
   ;; Pick all segments in content-a that are not inside content-b
   ;; Pick all segments in content-b that are not inside content-a
   (let [content
-        (d/concat
-         []
+        (concat
          (->> content-a-split (filter #(not (contains-segment? % content-b))))
          (->> content-b-split (filter #(not (contains-segment? % content-a)))))
 
         ;; Overlapping segments should be added when they are part of the border
         border-content
         (->> content-b-split
-             (filterv #(and (contains-segment? % content-a)
-                            (overlap-segment? % content-a-split)
-                            (not (inside-segment? % content)))))]
+             (filter #(and (contains-segment? % content-a)
+                           (overlap-segment? % content-a-split)
+                           (not (inside-segment? % content)))))]
 
-    (d/concat content border-content)))
+    ;; Ensure that the output is always a vector
+    (d/concat-vec content border-content)))
 
 (defn create-difference [content-a content-a-split content-b content-b-split]
   ;; Pick all segments in content-a that are not inside content-b
   ;; Pick all segments in content b that are inside content-a
   ;;  removing overlapping
-  (d/concat
-   []
+  (d/concat-vec
    (->> content-a-split (filter #(not (contains-segment? % content-b))))
 
    ;; Reverse second content so we can have holes inside other shapes
@@ -242,15 +242,14 @@
 (defn create-intersection [content-a content-a-split content-b content-b-split]
   ;; Pick all segments in content-a that are inside content-b
   ;; Pick all segments in content-b that are inside content-a
-  (d/concat
-   []
+  (d/concat-vec
    (->> content-a-split (filter #(contains-segment? % content-b)))
    (->> content-b-split (filter #(contains-segment? % content-a)))))
 
 
 (defn create-exclusion [content-a content-b]
   ;; Pick all segments
-  (d/concat [] content-a content-b))
+  (d/concat-vec content-a content-b))
 
 
 (defn fix-move-to

common/src/app/common/path/shapes_to_path.cljc

@@ -31,23 +31,22 @@
    :blur])
 
 (def style-properties
-  (d/concat
-   style-group-properties
-   [:fill-color
-    :fill-opacity
-    :fill-color-gradient
-    :fill-color-ref-file
-    :fill-color-ref-id
-    :fill-image
-    :stroke-color
-    :stroke-color-ref-file
-    :stroke-color-ref-id
-    :stroke-opacity
-    :stroke-style
-    :stroke-width
-    :stroke-alignment
-    :stroke-cap-start
-    :stroke-cap-end]))
+  (into style-group-properties
+        [:fill-color
+         :fill-opacity
+         :fill-color-gradient
+         :fill-color-ref-file
+         :fill-color-ref-id
+         :fill-image
+         :stroke-color
+         :stroke-color-ref-file
+         :stroke-color-ref-id
+         :stroke-opacity
+         :stroke-style
+         :stroke-width
+         :stroke-alignment
+         :stroke-cap-start
+         :stroke-cap-end]))
 
 (defn make-corner-arc
   "Creates a curvle corner for border radius"
@@ -177,18 +176,11 @@
                       (map #(get objects %))
                       (map #(convert-to-path % objects)))
         bool-type (:bool-type shape)
-        head (if (= bool-type :difference) (first children) (last children))
-        head (cond-> head
-               (and (contains? head :svg-attrs) (nil? (:fill-color head)))
-               (assoc :fill-color "#000000"))
-
-        head-data (select-keys head style-properties)
-        content (pb/content-bool (:bool-type shape) (mapv :content children))]
+        content (pb/content-bool bool-type (mapv :content children))]
 
     (-> shape
         (assoc :type :path)
         (assoc :content content)
-        (merge head-data)
         (d/without-keys dissoc-attrs))))
 
 (defn convert-to-path

common/src/app/common/path/subpaths.cljc

@@ -90,7 +90,7 @@
   [subpath other]
   (assert (pt= (:to subpath) (:from other)))
   (-> subpath
-      (update :data d/concat (rest (:data other)))
+      (update :data d/concat-vec (rest (:data other)))
       (assoc :to (:to other))))
 
 (defn- merge-paths

common/src/app/common/spec.cljc

@@ -111,16 +111,6 @@
 (s/def ::point gpt/point?)
 (s/def ::id ::uuid)
 
-(s/def ::words
-  (s/conformer
-   (fn [s]
-     (cond
-       (set? s)    s
-       (string? s) (into #{} (map keyword) (str/words s))
-       :else       ::s/invalid))
-   (fn [s]
-     (str/join " " (map name s)))))
-
 (defn bytes?
   "Test if a first parameter is a byte
   array or not."
@@ -134,7 +124,6 @@
 
 (s/def ::bytes bytes?)
 
-
 (s/def ::safe-integer
   #(and
     (int? %)
@@ -149,8 +138,28 @@
     (<= % max-safe-int)))
 
 
+;; --- SPEC: set of Keywords
+
+(s/def ::set-of-keywords
+  (s/conformer
+   (fn [s]
+     (let [xform (comp
+                  (map (fn [s]
+                         (cond
+                           (string? s) (keyword s)
+                           (keyword? s) s
+                           :else nil)))
+                  (filter identity))]
+       (cond
+         (set? s)    (into #{} xform s)
+         (string? s) (into #{} xform (str/words s))
+         :else       ::s/invalid)))
+   (fn [s]
+     (str/join " " (map name s)))))
+
 ;; --- SPEC: email
-(def email-re  #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
+
+(def email-re #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
 
 (s/def ::email
   (s/conformer
@@ -162,6 +171,23 @@
        ::s/invalid))
    str))
 
+(s/def ::set-of-emails
+  (s/conformer
+   (fn [v]
+     (cond
+       (string? v)
+       (into #{} (re-seq email-re v))
+
+       (or (set? v) (sequential? v))
+       (->> (str/join " " v)
+            (re-seq email-re)
+            (into #{}))
+
+       :else ::s/invalid))
+
+   (fn [v]
+     (str/join " " v))))
+
 ;; --- SPEC: set-of-str
 
 (s/def ::set-of-str
@@ -182,30 +208,30 @@
 ;; --- Macros
 
 (defn spec-assert*
-  [spec x message context]
-  (if (s/valid? spec x)
-    x
-    (let [data    (s/explain-data spec x)
-          explain (with-out-str (s/explain-out data))]
+  [spec val hint ctx]
+  (if (s/valid? spec val)
+    val
+    (let [data (s/explain-data spec val)]
       (ex/raise :type :assertion
                 :code :spec-validation
-                :hint message
-                :data data
-                :explain explain
-                :context context
-                #?@(:cljs [:stack (.-stack (ex-info message {}))])))))
-
+                :hint hint
+                :ctx  ctx
+                ::s/problems (::s/problems data)))))
 
 (defmacro assert
   "Development only assertion macro."
   [spec x]
   (when *assert*
     (let [nsdata  (:ns &env)
-          context (when nsdata
+          context (if nsdata
                     {:ns (str (:name nsdata))
                      :name (pr-str spec)
                      :line (:line &env)
-                     :file (:file (:meta nsdata))})
+                     :file (:file (:meta nsdata))}
+                    (let [mdata (meta &form)]
+                      {:ns   (str (ns-name *ns*))
+                       :name (pr-str spec)
+                       :line (:line mdata)}))
           message (str "spec assert: '" (pr-str spec) "'")]
       `(spec-assert* ~spec ~x ~message ~context))))
 
@@ -227,13 +253,10 @@
   [spec data]
   (let [result (s/conform spec data)]
     (when (= result ::s/invalid)
-      (let [data    (s/explain-data spec data)
-            explain (with-out-str
-                      (s/explain-out data))]
+      (let [data (s/explain-data spec data)]
         (throw (ex/error :type :validation
                          :code :spec-validation
-                         :explain explain
-                         :data data))))
+                         ::s/problems (::s/problems data)))))
     result))
 
 (defmacro instrument!

common/src/app/common/types/interactions.cljc

@@ -64,28 +64,29 @@
 (s/def ::url ::us/string)
 (s/def ::close-click-outside ::us/boolean)
 (s/def ::background-overlay ::us/boolean)
+(s/def ::preserve-scroll ::us/boolean)
 
 (defmulti action-opts-spec :action-type)
 
 (defmethod action-opts-spec :navigate [_]
-  (s/keys :req-un [::destination]))
+  (s/keys :opt-un [::destination ::preserve-scroll]))
 
 (defmethod action-opts-spec :open-overlay [_]
-  (s/keys :req-un [::destination
-                   ::overlay-position
+  (s/keys :req-un [::overlay-position
                    ::overlay-pos-type]
-          :opt-un [::close-click-outside
+          :opt-un [::destination
+                   ::close-click-outside
                    ::background-overlay]))
 
 (defmethod action-opts-spec :toggle-overlay [_]
-  (s/keys :req-un [::destination
-                   ::overlay-position
+  (s/keys :req-un [::overlay-position
                    ::overlay-pos-type]
-          :opt-un [::close-click-outside
+          :opt-un [::destination
+                   ::close-click-outside
                    ::background-overlay]))
 
 (defmethod action-opts-spec :close-overlay [_]
-  (s/keys :req-un [::destination]))
+  (s/keys :opt-un [::destination]))
 
 (defmethod action-opts-spec :prev-screen [_]
   (s/keys :req-un []))
@@ -151,7 +152,8 @@
       :navigate
       (assoc interaction
              :action-type action-type
-             :destination (get interaction :destination))
+             :destination (get interaction :destination)
+             :preserve-scroll false)
 
       (:open-overlay :toggle-overlay)
       (let [overlay-pos-type (get interaction :overlay-pos-type :center)
@@ -196,6 +198,10 @@
   (and (has-destination interaction)
        (some? (:destination interaction))))
 
+(defn has-preserve-scroll
+  [interaction]
+  (= (:action-type interaction) :navigate))
+
 (defn set-destination
   [interaction destination]
   (us/verify ::interaction interaction)
@@ -210,6 +216,13 @@
     (assoc :overlay-pos-type :center
            :overlay-position (gpt/point 0 0))))
 
+(defn set-preserve-scroll
+  [interaction preserve-scroll]
+  (us/verify ::interaction interaction)
+  (us/verify ::us/boolean preserve-scroll)
+  (assert (has-preserve-scroll interaction))
+  (assoc interaction :preserve-scroll preserve-scroll))
+
 (defn has-url
   [interaction]
   (= (:action-type interaction) :open-url))

common/src/app/common/types/page_options.cljc

@@ -15,11 +15,12 @@
 (s/def :artboard-grid.color/color ::us/string)
 (s/def :artboard-grid.color/opacity ::us/safe-number)
 
-(s/def :artboard-grid/size ::us/safe-integer)
+(s/def :artboard-grid/size (s/nilable ::us/safe-integer))
+(s/def :artboard-grid/item-length (s/nilable ::us/safe-number))
+
 (s/def :artboard-grid/color (s/keys :req-un [:artboard-grid.color/color
                                              :artboard-grid.color/opacity]))
 (s/def :artboard-grid/type #{:stretch :left :center :right})
-(s/def :artboard-grid/item-length (s/nilable ::us/safe-integer))
 (s/def :artboard-grid/gutter (s/nilable ::us/safe-integer))
 (s/def :artboard-grid/margin (s/nilable ::us/safe-integer))
 

common/src/app/common/types/radius.cljc

@@ -0,0 +1,90 @@
+;; 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.types.radius
+  (:require
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]))
+
+(s/def ::rx ::us/safe-number)
+(s/def ::ry ::us/safe-number)
+(s/def ::r1 ::us/safe-number)
+(s/def ::r2 ::us/safe-number)
+(s/def ::r3 ::us/safe-number)
+(s/def ::r4 ::us/safe-number)
+
+;; Rectangle shapes may define the radius of the corners in two modes:
+;; - radius-1 all corners have the same radius (although we store two
+;;   values :rx and :ry because svg uses it this way).
+;; - radius-4 each corner (top-left, top-right, bottom-right, bottom-left)
+;;   has an independent value. SVG does not allow this directly, so we
+;;   emulate it with paths.
+
+;; A shape never will have both :rx and :r1 simultaneously
+
+;; All operations take into account that the shape may not be a rectangle, and so
+;; it hasn't :rx nor :r1. In this case operations must leave shape untouched.
+
+(defn radius-mode
+  [shape]
+  (cond (:rx shape) :radius-1
+        (:r1 shape) :radius-4
+        :else       nil))
+
+(defn radius-1?
+  [shape]
+  (and (:rx shape) (not= (:rx shape) 0)))
+
+(defn radius-4?
+  [shape]
+  (and (:r1 shape)
+       (or (not= (:r1 shape) 0)
+           (not= (:r2 shape) 0)
+           (not= (:r3 shape) 0)
+           (not= (:r4 shape) 0))))
+
+(defn all-equal?
+  [shape]
+  (= (:r1 shape) (:r2 shape) (:r3 shape) (:r4 shape)))
+
+(defn switch-to-radius-1
+  [shape]
+  (let [r (if (all-equal? shape) (:r1 shape) 0)]
+    (cond-> shape
+      (:r1 shape)
+      (-> (assoc :rx r :ry r)
+          (dissoc :r1 :r2 :r3 :r4)))))
+
+(defn switch-to-radius-4
+  [shape]
+  (cond-> shape
+    (:rx shape)
+    (-> (assoc :r1 (:rx shape)
+               :r2 (:rx shape)
+               :r3 (:rx shape)
+               :r4 (:rx shape))
+        (dissoc :rx :ry))))
+
+(defn set-radius-1
+  [shape value]
+  (cond-> shape
+    (:r1 shape)
+    (-> (dissoc :r1 :r2 :r3 :r4)
+        (assoc :rx 0 :ry 0))
+
+    (:rx shape)
+    (assoc :rx value :ry value)))
+
+(defn set-radius-4
+  [shape attr value]
+  (cond-> shape
+    (:rx shape)
+    (-> (dissoc :rx :rx)
+        (assoc :r1 0 :r2 0 :r3 0 :r4 0))
+
+    (attr shape)
+    (assoc attr value)))
+

common/test/app/common/data_test.clj

@@ -0,0 +1,58 @@
+;; 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.data-test
+  (:require
+   [app.common.data :as d]
+   [clojure.test :as t]))
+
+(t/deftest concat-vec
+  (t/is (= [1 2 3]
+           (d/concat-vec [1] #{2} [3])))
+
+  (t/is (= [1 2]
+           (d/concat-vec '(1) [2])))
+
+  (t/is (= [1]
+           (d/concat-vec [1])))
+
+  (t/is (= [] (d/concat-vec))))
+
+(t/deftest concat-set
+  (t/is (= #{} (d/concat-set)))
+  (t/is (= #{1 2}
+           (d/concat-set [1] [2]))))
+
+(t/deftest remove-at-index
+  (t/is (= [1 2 3 4]
+           (d/remove-at-index [1 2 3 4 5] 4)))
+
+
+  (t/is (= [1 2 3 4]
+           (d/remove-at-index [5 1 2 3 4] 0)))
+
+  (t/is (= [1 2 3 4]
+           (d/remove-at-index [1 5 2 3 4] 1)))
+  )
+
+(t/deftest with-next
+  (t/is (= [[0 1] [1 2] [2 3] [3 4] [4 nil]]
+           (d/with-next (range 5)))))
+
+(t/deftest with-prev
+  (t/is (= [[0 nil] [1 0] [2 1] [3 2] [4 3]]
+           (d/with-prev (range 5)))))
+
+(t/deftest with-prev-next
+  (t/is (= [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]]
+           (d/with-prev-next (range 5)))))
+
+(t/deftest join
+  (t/is (= [[1 :a] [1 :b] [2 :a] [2 :b] [3 :a] [3 :b]]
+           (d/join [1 2 3] [:a :b])))
+  (t/is (= [1 10 100 2 20 200 3 30 300]
+           (d/join [1 2 3] [1 10 100] *))))
+

docker/devenv/Dockerfile

@@ -5,7 +5,7 @@ ARG DEBIAN_FRONTEND=noninteractive
 
 ENV NODE_VERSION=v14.17.6 \
     CLOJURE_VERSION=1.10.3.967 \
-    CLJKONDO_VERSION=2021.09.15 \
+    CLJKONDO_VERSION=2021.10.19 \
     BABASHKA_VERSION=0.6.1 \
     LANG=en_US.UTF-8 \
     LC_ALL=en_US.UTF-8

docker/devenv/docker-compose.yaml

@@ -50,7 +50,7 @@ services:
       - PENPOT_SMTP_PASSWORD=
       - PENPOT_SMTP_SSL=false
       - PENPOT_SMTP_TLS=false
-      - PENPOT_FLAGS="enable-cors"
+      - PENPOT_FLAGS="enable-cors enable-insecure-register enable-terms-and-privacy-checkbox"
 
       # LDAP setup
       - PENPOT_LDAP_HOST=ldap

docker/devenv/files/nginx.conf

@@ -89,6 +89,16 @@ http {
             error_page 301 302 307 = @handle_redirect;
         }
 
+        location ~ ^/github/penpot-files/(?<template_file>[a-zA-Z0-9\-\_\.]+) {
+            proxy_pass https://raw.githubusercontent.com/penpot/penpot-files/main/$template_file;
+            proxy_hide_header Access-Control-Allow-Origin;
+            proxy_set_header User-Agent "curl/7.74.0";
+            proxy_set_header Host "raw.githubusercontent.com";
+            proxy_set_header Accept "*/*";
+            add_header Access-Control-Allow-Origin $http_origin;
+            proxy_buffering off;
+        }
+
         location /internal/assets {
             internal;
             alias /home/penpot/penpot/backend/assets;

exporter/src/app/browser.cljs

@@ -104,7 +104,7 @@
 (def browser-pool-factory
   (letfn [(create []
             (let [path (cf/get :browser-executable-path "/usr/bin/google-chrome")]
-              (-> (pp/launch #js {:executablePath path :args #js ["--no-sandbox"]})
+              (-> (pp/launch #js {:executablePath path :args #js ["--no-sandbox" "--font-render-hinting=none"]})
                   (p/then (fn [browser]
                             (let [id (deref pool-browser-id)]
                               (log/info :origin "factory" :action "create" :browser-id id)

exporter/src/app/renderer/svg.cljs

@@ -23,7 +23,7 @@
    [app.renderer.bitmap :refer [create-cookie]]
    [promesa.core :as p]))
 
-(log/set-level "app.http.export-svg" :trace)
+(log/set-level "app.renderer.svg" :trace)
 
 (defn- xml->clj
   [data]
@@ -129,7 +129,7 @@
                   svgpath  (path/join basepath (str basename ".svg"))]
               (-> (sh/run-cmd! (str "potrace --flat -b svg " pbmpath " -o " svgpath))
                   (p/then (constantly svgpath)))))
-
+          
           (generate-color-layer [ppmpath color]
             (log/trace :fn :generate-color-layer :ppmpath ppmpath :color color)
             (let [basepath (path/dirname ppmpath)
@@ -146,16 +146,62 @@
                               {:color   color
                                :svgdata data}))))))
 
-          (join-color-layers [{:keys [x y width height] :as node} layers]
-            (log/trace :fn :join-color-layers)
+          (set-path-color [id color mapping node]
+            (let [color-mapping (get mapping color)]
+              (cond
+                (and (some? color-mapping)
+                     (= "transparent" (get color-mapping "type")))
+                (update node "attributes" assoc
+                        "fill" (get color-mapping "hex")
+                        "fill-opacity" (get color-mapping "opacity"))
+
+                (and (some? color-mapping)
+                     (= "gradient" (get color-mapping "type")))
+                (update node "attributes" assoc
+                        "fill" (str "url(#gradient-" id "-" (subs color 1) ")"))
+
+                :else
+                (update node "attributes" assoc "fill" color))))
+
+          (get-stops [data]
+            (->> (get-in data ["gradient" "stops"])
+                 (mapv (fn [stop-data]
+                         {"type" "element"
+                          "name" "stop"
+                          "attributes" {"offset" (get stop-data "offset")
+                                        "stop-color" (get stop-data "color")
+                                        "stop-opacity" (get stop-data "opacity")}}))))
+
+          (data->gradient-def [id [color data]]
+            (let [id (str "gradient-" id "-" (subs color 1))]
+              (if (= type "linear")
+                {"type" "element"
+                 "name" "linearGradient"
+                 "attributes" {"id" id "x1" "0.5" "y1" "1" "x2" "0.5" "y2" "0"}
+                 "elements" (get-stops data)}
+
+                {"type" "element"
+                 "name" "radialGradient"
+                 "attributes" {"id" id "cx" "0.5" "cy" "0.5" "r" "0.5"}
+                 "elements" (get-stops data)}
+                )))
+
+          (get-gradients [id mapping]
+            (->> mapping
+                 (filter (fn [[color data]]
+                           (= (get data "type") "gradient")))
+                 (mapv (partial data->gradient-def id))))
+
+          (join-color-layers [{:keys [id x y width height mapping] :as node} layers]
+            (log/trace :fn :join-color-layers :mapping mapping)
             (loop [result (-> (:svgdata (first layers))
                               (assoc "elements" []))
                    layers (seq layers)]
               (if-let [{:keys [color svgdata]} (first layers)]
                 (recur (->> (get svgdata "elements")
                             (filter #(= (get % "name") "g"))
-                            (map #(update % "attributes" assoc "fill" color))
-                            (update result "elements" d/concat))
+                            (map (partial set-path-color id color mapping))
+                            (update result "elements" into))
                        (rest layers))
 
                 ;; Now we have the result containing the svgdata of a
@@ -166,22 +212,33 @@
                                     (parse-viewbox))
                       transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y
                                          (/ width (:width vbox))
-                                         (/ height (:height vbox)))]
+                                         (/ height (:height vbox)))
+
+                      gradient-defs (get-gradients id mapping)
+
+                      elements
+                      (->> (get result "elements")
+                           (mapv (fn [group]
+                                   (let [paths (get group "elements")]
+                                     (if (= 1 (count paths))
+                                       (let [path (first paths)]
+                                         (update path "attributes"
+                                                 (fn [attrs]
+                                                   (-> attrs
+                                                       (d/merge (get group "attributes"))
+                                                       (update "transform" #(str transform " " %))))))
+                                       (update-in group ["attributes" "transform"] #(str transform " " %)))))))
+
+
+                      elements (cond->> elements
+                                 (not (empty? gradient-defs))
+                                 (into [{"type" "element" "name" "defs" "attributes" {}
+                                         "elements" gradient-defs}]))]
+
                   (-> result
                       (assoc "name" "g")
                       (assoc "attributes" {})
-                      (update "elements" (fn [elements]
-                                           (mapv (fn [group]
-                                                   (let [paths (get group "elements")]
-                                                     (if (= 1 (count paths))
-                                                       (let [path (first paths)]
-                                                         (update path "attributes"
-                                                                 (fn [attrs]
-                                                                   (-> attrs
-                                                                       (d/merge (get group "attributes"))
-                                                                       (update "transform" #(str transform " " %))))))
-                                                       (update-in group ["attributes" "transform"] #(str transform " " %)))))
-                                                 elements))))))))
+                      (assoc "elements" elements))))))
 
           (convert-to-svg [ppmpath {:keys [colors] :as node}]
             (log/trace :fn :convert-to-svg :ppmpath ppmpath :colors colors)
@@ -201,25 +258,28 @@
                          :svgdata svgdata))))
 
           (extract-element-attrs [^js element]
-            (let [^js attrs  (.. element -attributes)
-                  ^js colors (.. element -dataset -colors)]
-              #js {:id     (.. attrs -id -value)
-                   :x      (.. attrs -x -value)
-                   :y      (.. attrs -y -value)
-                   :width  (.. attrs -width -value)
-                   :height (.. attrs -height -value)
-                   :colors (.split colors ",")}))
+            (let [^js attrs   (.. element -attributes)
+                  ^js colors  (.. element -dataset -colors)
+                  ^js mapping (.. element -dataset -mapping)]
+              #js {:id      (.. attrs -id -value)
+                   :x       (.. attrs -x -value)
+                   :y       (.. attrs -y -value)
+                   :width   (.. attrs -width -value)
+                   :height  (.. attrs -height -value)
+                   :colors  (.split colors ",")
+                   :mapping (js/JSON.parse mapping)}))
 
           (extract-single-node [[shot node]]
             (log/trace :fn :extract-single-node)
 
             (p/let [attrs (bw/eval! node extract-element-attrs)]
-              {:id     (unchecked-get attrs "id")
-               :x      (unchecked-get attrs "x")
-               :y      (unchecked-get attrs "y")
-               :width  (unchecked-get attrs "width")
-               :height (unchecked-get attrs "height")
-               :colors (vec (unchecked-get attrs "colors"))
+              {:id      (unchecked-get attrs "id")
+               :x       (unchecked-get attrs "x")
+               :y       (unchecked-get attrs "y")
+               :width   (unchecked-get attrs "width")
+               :height  (unchecked-get attrs "height")
+               :colors  (vec (unchecked-get attrs "colors"))
+               :mapping (js->clj (unchecked-get attrs "mapping"))
                :data   shot}))
 
           (resolve-text-node [page node]
@@ -313,3 +373,4 @@
                         ".svg"))
      :length (alength content)
      :mime-type "image/svg+xml"}))
+

frontend/deps.edn

@@ -22,8 +22,9 @@
    :main-opts ["-m" "antq.core"]}
 
   :dev
-  {:extra-deps
-   {thheller/shadow-cljs {:mvn/version "2.15.9"}
+  {:extra-paths ["dev"]
+   :extra-deps
+   {thheller/shadow-cljs {:mvn/version "2.15.12"}
     cider/cider-nrepl {:mvn/version "0.26.0"}}}
 
   :shadow-cljs

frontend/dev/bench/core.cljs

@@ -1,112 +0,0 @@
-(ns bench.core
-  (:require [kdtree.core :as k]
-            [intervaltree.core :as it]
-            [cljs.pprint :refer (pprint)]
-            [cljs.nodejs :as node]))
-
-(enable-console-print!)
-
-;; --- Index Initialization Bechmark
-
-(defn- bench-init-10000
-  []
-  (println "1000x1000,10 -> 10000 points")
-  (time
-   (k/generate 1000 1000 10 10)))
-
-(defn- bench-init-250000
-  []
-  (time
-   (k/generate 5000 5000 10 10)))
-
-(defn bench-init
-  []
-  (bench-init-10000)
-  (bench-init-10000)
-  (bench-init-250000)
-  (bench-init-250000)
-  (bench-init-10000)
-  (bench-init-10000)
-  (bench-init-250000)
-  (bench-init-250000))
-
-;; --- Nearest Search Benchmark
-
-(defn- bench-knn-160000
-  []
-  (let [tree (k/create)]
-    (k/setup tree 4000 4000 10 10)
-    (println "KNN Search (160000 points) 1000 times")
-    (time
-     (dotimes [i 1000]
-       (let [pt #js [(rand-int 400)
-                     (rand-int 400)]]
-         (k/nearest tree pt 2))))))
-
-
-(defn- bench-knn-360000
-  []
-  (let [tree (k/create)]
-    (k/initialize tree 6000 6000 10 10)
-    (println "KNN Search (360000 points) 1000 times")
-    (time
-     (dotimes [i 1000]
-       (let [pt #js [(rand-int 600)
-                     (rand-int 600)]]
-         (k/nearest tree pt 2))))))
-
-(defn bench-knn
-  []
-  (bench-knn-160000)
-  (bench-knn-360000))
-
-;; --- Accuracity tests
-
-(defn test-accuracity
-  []
-  (let [tree (k/create)]
-    (k/setup tree 4000 4000 20 20)
-    (print "[1742 1419]")
-    (pprint (js->clj (k/nearest tree #js [1742 1419] 6)))
-    (print "[1742 1420]")
-    (pprint (js->clj (k/nearest tree #js [1742 1420] 6)))
-    ))
-
-(defn test-interval
-  []
-  (let [tree (it/create)]
-    (it/add tree #js [1 5])
-    (it/add tree #js [5 7])
-    (it/add tree #js [-4 -1])
-    (it/add tree #js [-10 -3])
-    (it/add tree #js [-20 -10])
-    (it/add tree #js [20 30])
-    (it/add tree #js [3 9])
-    (it/add tree #js [100 200])
-    (it/add tree #js [1000 2000])
-    (it/add tree #js [6 9])
-
-    (js/console.dir tree #js {"depth" nil})
-    (js/console.log "contains", 4, (it/contains tree 4))
-    (js/console.log "contains", 0, (it/contains tree 0))
-    ))
-
-(defn main
-  [& [type]]
-  (cond
-    (= type "kd-init")
-    (bench-init)
-
-    (= type "kd-search")
-    (bench-knn)
-
-    (= type "kd-test")
-    (test-accuracity)
-
-    (= type "interval")
-    (test-interval)
-
-    :else
-    (println "not implemented")))
-
-(set! *main-cli-fn* main)

frontend/dev/cljs/user.cljs

@@ -0,0 +1,5 @@
+(ns cljs.user)
+
+(defn hello
+  []
+  (js/console.log "hello"))

frontend/gulpfile.js

@@ -25,6 +25,17 @@ paths.resources = "./resources/";
 paths.output = "./resources/public/";
 paths.dist = "./target/dist/";
 
+/***********************************************
+ * Marked Extensions
+ ***********************************************/
+
+const renderer = {
+  link(href, title, text) {
+    return `<a href="${href}" target="_blank">${text}</a>`;
+  }
+};
+
+marked.use({renderer});
 
 /***********************************************
  * Helpers

frontend/package.json

@@ -23,7 +23,7 @@
     "start": "npm-run-all --parallel watch-gulp watch-main"
   },
   "devDependencies": {
-    "autoprefixer": "^10.2.4",
+    "autoprefixer": "^10.3.7",
     "gettext-parser": "^4.0.4",
     "gulp": "4.0.2",
     "gulp-concat": "^2.6.1",
@@ -35,36 +35,36 @@
     "gulp-sourcemaps": "^3.0.0",
     "gulp-svg-sprite": "^1.5.0",
     "map-stream": "0.0.7",
-    "marked": "^3.0.4",
+    "marked": "^3.0.8",
     "mkdirp": "^1.0.4",
-    "nodemon": "^2.0.13",
+    "nodemon": "^2.0.14",
     "npm-run-all": "^4.1.5",
-    "postcss": "^8.3.5",
+    "postcss": "^8.3.11",
     "postcss-clean": "^1.2.2",
     "rimraf": "^3.0.0",
-    "sass": "^1.35.1",
-    "shadow-cljs": "2.15.9"
+    "sass": "^1.43.4",
+    "shadow-cljs": "2.15.12"
   },
   "dependencies": {
-    "@sentry/browser": "^6.12.0",
-    "@sentry/tracing": "^6.12.0",
-    "date-fns": "^2.22.1",
+    "@sentry/browser": "^6.13.3",
+    "@sentry/tracing": "^6.13.3",
+    "date-fns": "^2.25.0",
     "draft-js": "^0.11.7",
-    "highlight.js": "^11.0.1",
+    "highlight.js": "^11.3.1",
     "js-beautify": "^1.14.0",
     "jszip": "^3.6.0",
     "luxon": "^2.0.2",
     "mousetrap": "^1.6.5",
-    "opentype.js": "^1.3.3",
+    "opentype.js": "^1.3.4",
     "randomcolor": "^0.6.2",
     "react": "~17.0.2",
     "react-dom": "~17.0.2",
     "react-virtualized": "^9.22.3",
-    "rxjs": "~7.2.0",
+    "rxjs": "~7.4.0",
     "sax": "^1.2.4",
     "source-map-support": "^0.5.16",
     "tdigest": "^0.1.1",
-    "ua-parser-js": "^0.7.28",
+    "ua-parser-js": "^1.0.2",
     "xregexp": "^5.0.1"
   }
 }