📎 Set version to 1.8.1-alpha.

Fix pdf pages

.clj-kondo/config.edn

@@ -23,6 +23,9 @@
  {:unsorted-required-namespaces
   {:level :warning}
 
+  :potok/reify-type
+  {:level :error}
+
   :unresolved-namespace
   {:level :warning
    :exclude [data_readers]}

.clj-kondo/hooks/export.clj

@@ -10,15 +10,34 @@
                   sname])]
     {:node result}))
 
+(def registry (atom {}))
+
 (defn potok-reify
-  [{:keys [:node]}]
+  [{:keys [:node :filename] :as params}]
   (let [[rnode rtype & other] (:children node)
-        result  (api/list-node
-                 (into [(api/token-node (symbol "deftype"))
-                        (api/token-node (gensym (name (:k rtype))))
-                        (api/vector-node [])]
-                       other))]
-    {:node result}))
+        rsym (symbol (str "event-type-" (name (:k rtype))))
+        reg  (get @registry filename #{})]
+    (when-not (:namespaced? rtype)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message "ptk/reify type should be namespaced"
+                           :type :potok/reify-type
+                           :row row
+                           :col col})))
+
+    (if (contains? reg rsym)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message (str "duplicate type: " (name (:k rtype)))
+                           :type :potok/reify-type
+                           :row row
+                           :col col}))
+      (swap! registry update filename (fnil conj #{}) rsym))
+
+    (let [result  (api/list-node
+                   (into [(api/token-node (symbol "deftype"))
+                          (api/token-node rsym)
+                          (api/vector-node [])]
+                         other))]
+      {:node result})))
 
 (defn clojure-specify
   [{:keys [:node]}]

CHANGES.md

@@ -1,15 +1,120 @@
-# CHANGELOG #
+# CHANGELOG
 
 ## :rocket: Next
 
+### :boom: Breaking changes
 ### :sparkles: New features
+### :bug: Bugs fixed
+### :arrow_up: Deps updates
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
+
+## 1.8.1-alpha
 
 ### :bug: Bugs fixed
 
+- Fix project renaming issue (and some other related to the same underlying bug).
+- Fix internal exception on audit log persistence layer.
+- Set proper environment variable on docker images for chrome executable.
+- Fix internal metrics on websocket connections.
+
+
+## 1.8.0-alpha
+
+### :boom: Breaking changes
+
+- This release includes a new approach for handling share links, and
+  this feature is incompatible with the previous one. This means that
+  all the public share links generated previously will stop working.
+
+### :sparkles: New features
+
+- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814).
+- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107).
+- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428).
+- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386).
+- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883).
+- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895).
+- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374).
+- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047).
+- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799).
+- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921).
+- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823).
+- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800).
+- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550).
+- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844).
+
+### :bug: Bugs fixed
+
+- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929).
+- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935).
+- Fix problem with zoom and selection [Taiga #1919](https://tree.taiga.io/project/penpot/issue/1919)
+- Fix problem with borders on shape export [#1092](https://github.com/penpot/penpot/issues/1092)
+- Fix thumbnail cropping issue [Taiga #1964](https://tree.taiga.io/project/penpot/issue/1964)
+- Fix repeated fetch on file selection [Taiga #1933](https://tree.taiga.io/project/penpot/issue/1933)
+- Fix rename typography on text options [Taiga #1963](https://tree.taiga.io/project/penpot/issue/1963)
+- Fix problems with order in groups [Taiga #1960](https://tree.taiga.io/project/penpot/issue/1960)
+- Fix SVG components preview [#1134](https://github.com/penpot/penpot/issues/1134)
+- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969)
+- Fix problem with import broken images links [#1197](https://github.com/penpot/penpot/issues/1197)
+- Fix problem while moving imported SVG's [#1199](https://github.com/penpot/penpot/issues/1199)
+
 ### :arrow_up: Deps updates
 ### :boom: Breaking changes
 ### :heart: Community contributions by (Thank you!)
 
+- eduayme [#1129](https://github.com/penpot/penpot/pull/1129).
+
+
+## 1.7.4-alpha
+
+### :bug: Bugs fixed
+
+- Fix demo user creation (self-hosted only)
+- Add better ldap response validation and reporting (self-hosted only)
+
+
+## 1.7.3-alpha
+
+### :bug: Bugs fixed
+
+- Fix font uploading issue on Windows.
+
+
+## 1.7.2-alpha
+
+### :sparkles: New features
+
+- Add many improvements to text tool.
+
+### :bug: Bugs fixed
+
+- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894).
+- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892).
+- Fix properly messages lifecycle on navigate.
+- Fix handling repeated names on duplicate object trees.
+- Fix group naming on group creation.
+- Fix some issues in svg transformation.
+
+### :arrow_up: Deps updates
+
+- Update frontend build tooling.
+
+### :heart: Community contributions by (Thank you!)
+
+- soultipsy [#1100](https://github.com/penpot/penpot/pull/1100)
+
+
+## 1.7.1-alpha
+
+### :bug: Bugs fixed
+
+- Fix issue related to the GC and images in path shapes.
+- Fix issue on the shape order on some undo operations.
+- Fix issue on undo page deletion.
+- Fix some issues related to constraints.
+
+
 ## 1.7.0-alpha
 
 ### :sparkles: New features
@@ -45,10 +150,6 @@
 - Fix dynamic alignment enabled with hidden objects [#1063](https://github.com/penpot/penpot/issues/1063)
 
 
-### :arrow_up: Deps updates
-### :boom: Breaking changes
-### :heart: Community contributions by (Thank you!)
-
 ## 1.6.5-alpha
 
 ### :bug: Bugs fixed

backend/resources/emails-mjml/register/en.mjml

@@ -22,7 +22,7 @@
         <mj-text font-size="24px" font-weight="600">Hello {{name}}!</mj-text>
         <mj-text>
           Thanks for signing up for your Penpot account! Please verify your
-          email using the link below adn get started building mockups and
+          email using the link below and get started building mockups and
           prototypes today!
         </mj-text>
         <mj-button href="{{ public-uri }}/#/auth/verify-token?token={{token}}">

backend/resources/emails/register/en.html

@@ -173,7 +173,7 @@
                   </tr>
                   <tr>
                     <td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below adn get started building mockups and prototypes today!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below and get started building mockups and prototypes today!</div>
                     </td>
                   </tr>
                   <tr>
@@ -465,4 +465,4 @@
   </div>
 </body>
 
-</html>
+</html>

backend/resources/emails/register/en.txt

@@ -1,7 +1,7 @@
 Hello {{name}}!
 
 Thanks for signing up for your Penpot account! Please verify your email using the
-link below adn get started building mockups and prototypes today!
+link below and get started building mockups and prototypes today!
 
 {{ public-uri }}/#/auth/verify-token?token={{token}}
 

backend/src/app/config.clj

@@ -58,7 +58,7 @@
    :srepl-host "127.0.0.1"
    :srepl-port 6062
 
-   :assets-storage-backend :fs
+   :assets-storage-backend :assets-fs
    :storage-assets-fs-directory "assets"
 
    :feedback-destination "info@example.com"

backend/src/app/db.clj

@@ -231,9 +231,9 @@
 (defn get-by-params
   ([ds table params]
    (get-by-params ds table params nil))
-  ([ds table params {:keys [uncheked] :or {uncheked false} :as opts}]
+  ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
    (let [res (exec-one! ds (sql/select table params opts))]
-     (when (and (not uncheked) (or (not res) (is-deleted? res)))
+     (when (and check-not-found (or (not res) (is-deleted? res)))
        (ex/raise :type :not-found
                  :table table
                  :hint "database object not found"))
@@ -267,13 +267,28 @@
   (instance? PGpoint v))
 
 (defn pgarray?
-  [v]
-  (instance? PgArray v))
+  ([v] (instance? PgArray v))
+  ([v type]
+   (and (instance? PgArray v)
+        (= type (.getBaseTypeName ^PgArray v)))))
 
 (defn pgarray-of-uuid?
   [v]
   (and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v))))
 
+(defn decode-pgarray
+  ([v] (into [] (.getArray ^PgArray v)))
+  ([v in] (into in (.getArray ^PgArray v)))
+  ([v in xf] (into in xf (.getArray ^PgArray v))))
+
+(defn pgarray->set
+  [v]
+  (set (.getArray ^PgArray v)))
+
+(defn pgarray->vector
+  [v]
+  (vec (.getArray ^PgArray v)))
+
 (defn pgpoint
   [p]
   (PGpoint. (:x p) (:y p)))
@@ -285,7 +300,6 @@
       (.createArrayOf conn ^String type (into-array Object objects))
       (.createArrayOf conn ^String type objects))))
 
-
 (defn decode-pgpoint
   [^PGpoint v]
   (gpt/point (.-x v) (.-y v)))
@@ -369,15 +383,6 @@
     (.setType "jsonb")
     (.setValue (json/encode-str data))))
 
-(defn pgarray->set
-  [v]
-  (set (.getArray ^PgArray v)))
-
-(defn pgarray->vector
-  [v]
-  (vec (.getArray ^PgArray v)))
-
-
 ;; --- Locks
 
 (defn- xact-check-param

backend/src/app/http.clj

@@ -114,9 +114,14 @@
 (s/def ::storage map?)
 (s/def ::assets map?)
 (s/def ::feedback fn?)
+(s/def ::error-report-handler fn?)
+(s/def ::audit-http-handler fn?)
 
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::rpc ::session ::mtx/metrics ::oauth ::storage ::assets ::feedback]))
+  (s/keys :req-un [::rpc ::session ::mtx/metrics
+                   ::oauth ::storage ::assets ::feedback
+                   ::error-report-handler
+                   ::audit-http-handler]))
 
 (defmethod ig/init-key ::router
   [_ {:keys [session rpc oauth metrics assets feedback] :as cfg}]
@@ -147,10 +152,12 @@
 
      ["/feedback" {:middleware [(:middleware session)]
                    :post feedback}]
-
      ["/auth/oauth/:provider" {:post (:handler oauth)}]
      ["/auth/oauth/:provider/callback" {:get (:callback-handler oauth)}]
 
+     ["/audit/events" {:middleware [(:middleware session)]
+                       :post (:audit-http-handler cfg)}]
+
      ["/rpc" {:middleware [(:middleware session)]}
       ["/query/:type" {:get (:query-handler rpc)
                        :post (:query-handler rpc)}]

backend/src/app/http/middleware.clj

@@ -13,7 +13,6 @@
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
    [clojure.java.io :as io]
-   [ring.core.protocols :as rp]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
@@ -74,28 +73,15 @@
   {:name ::parse-request-body
    :compile (constantly wrap-parse-request-body)})
 
-(defn- transit-streamable-body
-  [data opts]
-  (reify rp/StreamableResponseBody
-    (write-body-to-stream [_ response output-stream]
-      (try
-        (let [tw (t/writer output-stream opts)]
-          (t/write! tw data))
-        (finally
-          (.close ^java.io.OutputStream output-stream))))))
-
 (defn- impl-format-response-body
-  [response request]
+  [response _request]
   (let [body (:body response)
-        opts {:type :json-verbose}]
+        opts {:type :json}]
     (cond
       (coll? body)
       (-> response
           (update :headers assoc "content-type" "application/transit+json")
-          (assoc :body
-                 (if (= :post (:request-method request))
-                   (transit-streamable-body body opts)
-                   (t/encode body opts))))
+          (assoc :body (t/encode body opts)))
 
       (nil? body)
       (assoc response :status 204 :body "")

backend/src/app/loggers/audit.clj

@@ -23,7 +23,8 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
+   [lambdaisland.uri :as u]
+   [promesa.exec :as px]))
 
 (defn parse-client-ip
   [{:keys [headers] :as request}]
@@ -67,6 +68,65 @@
 
     (update event :props #(-> % clean-common clean-profile-id clean-complex-data))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HTTP Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare persist-http-events)
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::type ::us/string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::timestamp dt/instant?)
+(s/def ::context (s/map-of ::us/keyword any?))
+
+(s/def ::event
+  (s/keys :req-un [::type ::name ::props ::timestamp ::profile-id]
+          :opt-un [::context]))
+
+(s/def ::events (s/every ::event))
+
+(defmethod ig/init-key ::http-handler
+  [_  {:keys [executor enabled] :as cfg}]
+  (fn [{:keys [params _headers _cookies profile-id] :as request}]
+    (when enabled
+      (let [events  (->> (:events params)
+                         (remove #(not= profile-id (:profile-id %)))
+                         (us/conform ::events))
+            ip-addr (parse-client-ip request)
+            cfg     (-> cfg
+                        (assoc :source "frontend")
+                        (assoc :events events)
+                        (assoc :ip-addr ip-addr))]
+        (px/run! executor #(persist-http-events cfg))))
+    {:status 204 :body ""}))
+
+(defn- persist-http-events
+  [{:keys [pool events ip-addr source] :as cfg}]
+  (try
+    (let [columns    [:id :name :source :type :tracked-at :profile-id :ip-addr :props :context]
+          prepare-xf (map (fn [event]
+                            [(uuid/next)
+                             (:name event)
+                             source
+                             (:type event)
+                             (:timestamp event)
+                             (:profile-id event)
+                             (db/inet ip-addr)
+                             (db/tjson (:props event))
+                             (db/tjson (d/without-nils (:context event)))]))
+          events     (us/conform ::events events)
+          rows       (into [] prepare-xf events)]
+      (db/insert-multi! pool :audit-log columns rows))
+    (catch Throwable e
+      (let [xdata (ex-data e)]
+        (if (= :spec-validation (:code xdata))
+          (l/error ::l/raw (str "spec validation on persist-events:\n"
+                                (:explain xdata)))
+          (l/error :hint "error on persist-events"
+                   :cause e))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Collector
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -103,7 +163,9 @@
           (recur)))
 
       (fn [& {:keys [cmd] :as params}]
-        (let [params (dissoc params :cmd)]
+        (let [params (-> params
+                         (dissoc :cmd)
+                         (assoc :tracked-at (dt/now)))]
           (case cmd
             :stop   (a/close! input)
             :submit (when-not (a/offer! input params)
@@ -117,14 +179,16 @@
              (:name event)
              (:type event)
              (:profile-id event)
+             (:tracked-at event)
              (some-> (:ip-addr event) db/inet)
-             (db/tjson (:props event))])]
-
+             (db/tjson (:props event))
+             "backend"])]
     (aa/with-thread executor
-      (db/with-atomic [conn pool]
-        (db/insert-multi! conn :audit-log
-                          [:id :name :type :profile-id :ip-addr :props]
-                          (sequence (map event->row) events))))))
+      (when (seq events)
+        (db/with-atomic [conn pool]
+          (db/insert-multi! conn :audit-log
+                            [:id :name :type :profile-id :tracked-at :ip-addr :props :source]
+                            (sequence (map event->row) events)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Archive Task
@@ -144,16 +208,22 @@
 
 (defmethod ig/init-key ::archive-task
   [_ {:keys [uri enabled] :as cfg}]
-  (fn [_]
-    (when (and enabled (not uri))
-      (ex/raise :type :internal
-                :code :task-not-configured
-                :hint "archive task not configured, missing uri"))
-    (loop []
-      (let [res (archive-events cfg)]
-        (when (= res :continue)
-          (aa/thread-sleep 200)
-          (recur))))))
+  (fn [props]
+    ;; NOTE: this let allows overwrite default configured values from
+    ;; the repl, when manually invoking the task.
+    (let [enabled (or enabled (:enabled props false))
+          uri     (or uri (:uri props))
+          cfg     (assoc cfg :uri uri)]
+      (when (and enabled (not uri))
+        (ex/raise :type :internal
+                  :code :task-not-configured
+                  :hint "archive task not configured, missing uri"))
+      (when enabled
+        (loop []
+          (let [res (archive-events cfg)]
+            (when (= res :continue)
+              (aa/thread-sleep 200)
+              (recur))))))))
 
 (def sql:retrieve-batch-of-audit-log
   "select * from audit_log
@@ -164,22 +234,27 @@
 
 (defn archive-events
   [{:keys [pool uri tokens] :as cfg}]
-  (letfn [(decode-row [{:keys [props ip-addr] :as row}]
+  (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
             (cond-> row
               (db/pgobject? props)
               (assoc :props (db/decode-transit-pgobject props))
 
+              (db/pgobject? context)
+              (assoc :context (db/decode-transit-pgobject context))
+
               (db/pgobject? ip-addr "inet")
               (assoc :ip-addr (db/decode-inet ip-addr))))
 
-          (row->event [{:keys [name type created-at profile-id props ip-addr]}]
-            (cond-> {:type type
-                     :name name
-                     :timestamp created-at
-                     :profile-id profile-id
-                     :props props}
-              (some? ip-addr)
-              (update :context assoc :source-ip ip-addr)))
+          (row->event [row]
+            (select-keys row [:type
+                              :name
+                              :source
+                              :created-at
+                              :tracked-at
+                              :profile-id
+                              :ip-addr
+                              :props
+                              :context]))
 
           (send [events]
             (let [token   (tokens :generate {:iss "authentication"

backend/src/app/loggers/mattermost.clj

@@ -60,18 +60,15 @@
     (a/close! output)))
 
 (defn- send-mattermost-notification!
-  [cfg {:keys [host version id] :as cdata}]
+  [cfg {:keys [host id] :as cdata}]
   (try
     (let [uri  (:uri cfg)
-          text (str "Unhandled exception:\n"
-                    "- detail: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
-                    "- profile-id: `" (:profile-id cdata) "`\n"
-                    "- host: `" host "`\n"
-                    "- version: `" version "`\n")
-          rsp    (http/send! {:uri uri
-                              :method :post
-                              :headers {"content-type" "application/json"}
-                              :body (json/encode-str {:text text})})]
+          text (str "Unhandled exception (host: " host ", url: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
+                    "- profile-id: #" (:profile-id cdata) "\n")
+          rsp  (http/send! {:uri uri
+                            :method :post
+                            :headers {"content-type" "application/json"}
+                            :body (json/encode-str {:text text})})]
       (when (not= (:status rsp) 200)
         (l/error :hint "error on sending data to mattermost"
                  :response (pr-str rsp))))

backend/src/app/main.clj

@@ -28,11 +28,24 @@
      {:name "actions_profile_register_count"
       :help "A global counter of user registrations."
       :type :counter}
+
      :profile-activation
      {:name "actions_profile_activation_count"
       :help "A global counter of profile activations"
+      :type :counter}
+
+     :update-file-changes
+     {:name "rpc_update_file_changes_total"
+      :help "A total number of changes submitted to update-file."
+      :type :counter}
+
+     :update-file-bytes-processed
+     {:name "rpc_update_file_bytes_processed_total"
+      :help "A total number of bytes processed by update-file."
       :type :counter}}}
 
+
+
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
@@ -95,6 +108,7 @@
     :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.mattermost/handler)}
 
    :app.http.assets/handlers
@@ -289,6 +303,11 @@
    :app.loggers.zmq/receiver
    {:endpoint (cf/get :loggers-zmq-uri)}
 
+   :app.loggers.audit/http-handler
+   {:enabled  (cf/get :audit-enabled false)
+    :pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)}
+
    :app.loggers.audit/collector
    {:enabled  (cf/get :audit-enabled false)
     :pool     (ig/ref :app.db/pool)
@@ -322,15 +341,17 @@
    :app.storage/storage
    {:pool     (ig/ref :app.db/pool)
     :executor (ig/ref :app.worker/executor)
-    :backend  (cf/get :assets-storage-backend :assets-fs)
-    :backends {:assets-s3 (ig/ref [::assets :app.storage.s3/backend])
+
+    :backends {
+               :assets-s3 (ig/ref [::assets :app.storage.s3/backend])
                :assets-db (ig/ref [::assets :app.storage.db/backend])
                :assets-fs (ig/ref [::assets :app.storage.fs/backend])
-               :s3        (ig/ref [::assets :app.storage.s3/backend])
-               :db        (ig/ref [::assets :app.storage.db/backend])
-               :fs        (ig/ref [::assets :app.storage.fs/backend])
                :tmp       (ig/ref [::tmp  :app.storage.fs/backend])
-               :fdata-s3  (ig/ref [::fdata :app.storage.s3/backend])}}
+               :fdata-s3  (ig/ref [::fdata :app.storage.s3/backend])
+
+               ;; keep this for backward compatibility
+               :s3        (ig/ref [::assets :app.storage.s3/backend])
+               :fs        (ig/ref [::assets :app.storage.fs/backend])}}
 
    [::fdata :app.storage.s3/backend]
    {:region (cf/get :storage-fdata-s3-region)

backend/src/app/media.clj

@@ -11,6 +11,7 @@
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
    [app.common.spec :as us]
+   [app.config :as cf]
    [app.rlimits :as rlm]
    [app.rpc.queries.svg :as svg]
    [buddy.core.bytes :as bb]
@@ -28,10 +29,6 @@
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; --- Utility functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (s/def ::image-content-type cm/valid-image-types)
 (s/def ::font-content-type cm/valid-font-types)
 
@@ -330,3 +327,17 @@
               (= stype :ttf)
               (-> (assoc "font/otf" (ttf->otf sfnt))
                   (assoc "font/ttf" sfnt)))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn configure-assets-storage
+  "Given storage map, returns a storage configured with the apropriate
+  backend for assets."
+  [storage conn]
+  (-> storage
+      (assoc :conn conn)
+      (assoc :backend (cf/get :assets-storage-backend :assets-fs))))
+

backend/src/app/metrics.clj

@@ -92,18 +92,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd]
-        (.inc ^Counter instance))
-
-      (invoke [_ cmd labels]
-        (.. ^Counter instance
-            (labels (into-array String labels))
-            (inc))))))
+    {::instance instance
+     ::fn (fn [{:keys [by labels] :or {by 1}}]
+            (if labels
+              (.. ^Counter instance
+                  (labels (into-array String labels))
+                  (inc by))
+              (.inc ^Counter instance by)))}))
 
 (defn make-gauge
   [{:keys [name help registry reg labels] :as props}]
@@ -115,21 +111,16 @@
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
 
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
-
-      clojure.lang.IFn
-      (invoke [_ cmd]
-        (case cmd
-          :inc (.inc ^Gauge instance)
-          :dec (.dec ^Gauge instance)))
-
-      (invoke [_ cmd labels]
-        (let [labels (into-array String [labels])]
-          (case cmd
-            :inc (.. ^Gauge instance (labels labels) (inc))
-            :dec (.. ^Gauge instance (labels labels) (dec))))))))
+    {::instance instance
+     ::fn (fn [{:keys [cmd by labels] :or {by 1}}]
+            (if labels
+              (let [labels (into-array String [labels])]
+                (case cmd
+                  :inc (.. ^Gauge instance (labels labels) (inc by))
+                  :dec (.. ^Gauge instance (labels labels) (dec by))))
+              (case cmd
+                :inc (.inc ^Gauge instance by)
+                :dec (.dec ^Gauge instance by))))}))
 
 (def default-quantiles
   [[0.75 0.02]
@@ -150,18 +141,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd val]
-        (.observe ^Summary instance val))
-
-      (invoke [_ cmd val labels]
-        (.. ^Summary instance
-            (labels (into-array String labels))
-            (observe val))))))
+    {::instance instance
+     ::fn (fn [{:keys [val labels]}]
+            (if labels
+              (.. ^Summary instance
+                  (labels (into-array String labels))
+                  (observe val))
+              (.observe ^Summary instance val)))}))
 
 (def default-histogram-buckets
   [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
@@ -177,18 +164,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd val]
-        (.observe ^Histogram instance val))
-
-      (invoke [_ cmd val labels]
-        (.. ^Histogram instance
-            (labels (into-array String labels))
-            (observe val))))))
+    {::instance instance
+     ::fn (fn [{:keys [val labels]}]
+            (if labels
+              (.. ^Histogram instance
+                  (labels (into-array String labels))
+                  (observe val))
+              (.observe ^Histogram instance val)))}))
 
 (defn create
   [{:keys [type] :as props}]
@@ -205,19 +188,19 @@
      (with-meta
        (fn
          ([a]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a))
          ([a b]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a b))
          ([a b c]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a b c))
          ([a b c d]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a b c d))
          ([a b c d & more]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (apply origf a b c d more)))
        (assoc mdata ::original origf))))
   ([rootf mobj labels]
@@ -226,13 +209,13 @@
      (with-meta
        (fn
          ([a]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (origf a))
          ([a b]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (origf a b))
          ([a b & more]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (apply origf a b more)))
        (assoc mdata ::original origf)))))
 
@@ -245,15 +228,15 @@
          ([a]
          (with-measure
            :expr (origf a)
-           :cb   #(mobj :observe %)))
+           :cb   #((::fn mobj) {:val %})))
          ([a b]
           (with-measure
             :expr (origf a b)
-            :cb   #(mobj :observe %)))
+            :cb   #((::fn mobj) {:val %})))
          ([a b & more]
           (with-measure
             :expr (apply origf a b more)
-            :cb   #(mobj :observe %))))
+            :cb   #((::fn mobj) {:val %}))))
        (assoc mdata ::original origf))))
 
   ([rootf mobj labels]
@@ -264,26 +247,26 @@
          ([a]
          (with-measure
            :expr (origf a)
-           :cb   #(mobj :observe % labels)))
+           :cb   #((::fn mobj) {:val % :labels labels})))
          ([a b]
           (with-measure
             :expr (origf a b)
-            :cb   #(mobj :observe % labels)))
+            :cb   #((::fn mobj) {:val % :labels labels})))
          ([a b & more]
           (with-measure
             :expr (apply origf a b more)
-            :cb   #(mobj :observe % labels))))
+            :cb   #((::fn mobj) {:val % :labels labels}))))
        (assoc mdata ::original origf)))))
 
 (defn instrument-vars!
   [vars {:keys [wrap] :as props}]
   (let [obj (create props)]
     (cond
-      (instance? Counter @obj)
+      (instance? Counter (::instance obj))
       (doseq [var vars]
         (alter-var-root var (or wrap wrap-counter) obj))
 
-      (instance? Summary @obj)
+      (instance? Summary (::instance obj))
       (doseq [var vars]
         (alter-var-root var (or wrap wrap-summary) obj))
 
@@ -294,13 +277,13 @@
   [f {:keys [wrap] :as props}]
   (let [obj (create props)]
     (cond
-      (instance? Counter @obj)
+      (instance? Counter (::instance obj))
       ((or wrap wrap-counter) f obj)
 
-      (instance? Summary @obj)
+      (instance? Summary (::instance obj))
       ((or wrap wrap-summary) f obj)
 
-      (instance? Histogram @obj)
+      (instance? Histogram (::instance obj))
       ((or wrap wrap-summary) f obj)
 
       :else

backend/src/app/migrations.clj

@@ -193,6 +193,15 @@
 
    {:name "0061-mod-file-table"
     :fn (mg/resource "app/migrations/sql/0061-mod-file-table.sql")}
+
+   {:name "0062-fix-metadata-media"
+    :fn (mg/resource "app/migrations/sql/0062-fix-metadata-media.sql")}
+
+   {:name "0063-add-share-link-table"
+    :fn (mg/resource "app/migrations/sql/0063-add-share-link-table.sql")}
+
+   {:name "0064-mod-audit-log-table"
+    :fn (mg/resource "app/migrations/sql/0064-mod-audit-log-table.sql")}
    ])
 
 

backend/src/app/migrations/sql/0063-add-share-link-table.sql

@@ -0,0 +1,12 @@
+CREATE TABLE share_link (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+  file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE,
+  owner_id uuid NULL REFERENCES profile(id) ON DELETE SET NULL DEFERRABLE,
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+
+  pages uuid[],
+  flags text[]
+);
+
+CREATE INDEX share_link_file_id_idx ON share_link(file_id);
+CREATE INDEX share_link_owner_id_idx ON share_link(owner_id);

backend/src/app/migrations/sql/0064-mod-audit-log-table.sql

@@ -0,0 +1,13 @@
+ALTER TABLE audit_log
+  ADD COLUMN tracked_at timestamptz NULL DEFAULT clock_timestamp(),
+  ADD COLUMN source text NULL,
+  ADD COLUMN context jsonb NULL;
+
+ALTER TABLE audit_log
+  ALTER COLUMN source SET STORAGE external,
+  ALTER COLUMN context SET STORAGE external;
+
+UPDATE audit_log SET source = 'backend', tracked_at=created_at;
+
+-- ALTER TABLE audit_log ALTER COLUMN source SET NOT NULL;
+-- ALTER TABLE audit_log ALTER COLUMN tracked_at SET NOT NULL;

backend/src/app/notifications.clj

@@ -135,7 +135,7 @@
         ws-send      (mtx/wrap-counter ws-send mtx-messages ["send"])]
 
     (letfn [(on-connect [conn]
-              (mtx-aconn :inc)
+              ((::mtx/fn mtx-aconn) {:cmd :inc :by 1})
               ;; A subscription channel should use a lossy buffer
               ;; because we can't penalize normal clients when one
               ;; slow client is connected to the room.
@@ -162,8 +162,8 @@
                   (a/<! (handle-connect cfg))
 
                   ;; when connection is closed
-                  (mtx-aconn :dec)
-                  (mtx-sessions :observe (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0))
+                  ((::mtx/fn mtx-aconn) {:cmd :dec :by 1})
+                  ((::mtx/fn mtx-sessions) {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
 
                   ;; close subscription
                   (a/close! sub-ch))))

backend/src/app/rpc.clj

@@ -117,14 +117,14 @@
                 profile-id (or (:profile-id params')
                                (:profile-id result)
                                (::audit/profile-id resultm))
-                props      (d/merge params (::audit/props resultm))]
+                props      (d/merge params' (::audit/props resultm))]
             (audit :cmd :submit
                    :type (::type cfg)
                    :name (or (::audit/name resultm)
                              (::sv/name mdata))
                    :profile-id profile-id
                    :ip-addr (audit/parse-client-ip request)
-                   :props (audit/profile->props props))))
+                   :props props)))
 
         result))))
 
@@ -175,6 +175,7 @@
                      'app.rpc.mutations.management
                      'app.rpc.mutations.ldap
                      'app.rpc.mutations.fonts
+                     'app.rpc.mutations.share-link
                      'app.rpc.mutations.verify-token)
          (map (partial process-method cfg))
          (into {}))))

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

@@ -11,8 +11,8 @@
    [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]
    [app.rpc.queries.files :as files]
    [app.rpc.queries.projects :as proj]
@@ -288,11 +288,11 @@
 
 (defn- delete-from-storage
   [{:keys [storage] :as cfg} file]
-  (when-let [backend (simpl/resolve-backend storage (cf/get :fdata-storage-backend))]
+  (when-let [backend (simpl/resolve-backend storage (:data-backend file))]
     (simpl/del-object backend file)))
 
 (defn- update-file
-  [{:keys [conn] :as cfg} {:keys [file changes changes-with-metadata session-id profile-id] :as params}]
+  [{:keys [conn metrics] :as cfg} {:keys [file changes changes-with-metadata session-id profile-id] :as params}]
   (when (> (:revn params)
            (:revn file))
 
@@ -302,14 +302,22 @@
               :context {:incoming-revn (:revn params)
                         :stored-revn (:revn file)}))
 
-  (let [changes (if changes-with-metadata
+  (let [mtx1    (get-in metrics [:definitions :update-file-changes])
+        mtx2    (get-in metrics [:definitions :update-file-bytes-processed])
+
+        changes (if changes-with-metadata
                   (mapcat :changes changes-with-metadata)
                   changes)
 
+        ;; Trace the number of changes processed
+        _       ((::mtx/fn mtx1) {:by (count changes)})
+
         ts      (dt/now)
         file    (-> (files/retrieve-data cfg file)
                     (update :revn inc)
                     (update :data (fn [data]
+                                    ;; Trace the length of bytes of processed data
+                                    ((::mtx/fn mtx2) {:by (alength data)})
                                     (-> data
                                         (blob/decode)
                                         (assoc :id (:id file))

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

@@ -6,6 +6,7 @@
 
 (ns app.rpc.mutations.fonts
   (:require
+   [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -47,7 +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})
-        storage (assoc storage :conn conn)
+        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"}))
@@ -64,6 +67,13 @@
                   (sto/put-object storage {:content (sto/content fdata)
                                            :content-type "font/woff2"}))]
 
+    (when (and (nil? otf)
+               (nil? ttf)
+               (nil? woff1)
+               (nil? woff2))
+      (ex/raise :type :validation
+                :code :invalid-font-upload))
+
     (db/insert! conn :team-font-variant
                 {:id (uuid/next)
                  :team-id (:team-id params)

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

@@ -13,11 +13,20 @@
    [app.loggers.audit :as audit]
    [app.rpc.mutations.profile :as profile-m]
    [app.rpc.queries.profile :as profile-q]
+   [app.util.logging :as l]
    [app.util.services :as sv]
    [clj-ldap.client :as ldap]
    [clojure.spec.alpha :as s]
    [clojure.string]))
 
+
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::email ::us/email)
+(s/def ::backend ::us/not-empty-string)
+
+(s/def ::info-data
+  (s/keys :req-un [::fullname ::email ::backend]))
+
 (defn ^java.lang.AutoCloseable connect
   []
   (let [params {:ssl?      (cfg/get :ldap-ssl)
@@ -57,6 +66,13 @@
         (ex/raise :type :validation
                   :code :wrong-credentials))
 
+      (when-not (s/valid? ::info-data info)
+        (let [explain (s/explain-str ::info-data info)]
+          (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
+          (ex/raise :type :restriction
+                    :code :wrong-ldap-response
+                    :reason explain)))
+
       (let [profile (login-or-register cfg {:email (:email info)
                                             :backend (:backend info)
                                             :fullname (:fullname info)})]
@@ -94,7 +110,9 @@
                  (cfg/get :ldap-attrs-fullname)]
 
         base-dn (cfg/get :ldap-base-dn)
-        params  {:filter query :sizelimit 1 :attributes attrs}]
+        params  {:filter query
+                 :sizelimit 1
+                 :attributes attrs}]
     (first (ldap/search cpool base-dn params))))
 
 (defn- authenticate

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

@@ -32,7 +32,6 @@
 (s/def ::file-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 
-
 ;; --- Create File Media object (upload)
 
 (declare create-file-media-object)
@@ -94,10 +93,9 @@
 (defn create-file-media-object
   [{:keys [conn storage] :as cfg} {:keys [id file-id is-local name content] :as params}]
   (media/validate-media-type (:content-type content))
-  (let [storage      (assoc storage :conn conn)
+  (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}})
 
         thumb        (when (and (not (svg-image? source-info))

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

@@ -9,12 +9,13 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [app.emails :as eml]
    [app.http.oauth :refer [extract-props]]
    [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]
@@ -99,11 +100,11 @@
 
 (sv/defmethod ::prepare-register-profile {:auth false}
   [{:keys [pool tokens] :as cfg} params]
-  (when-not (cfg/get :registration-enabled)
+  (when-not (cf/get :registration-enabled)
     (ex/raise :type :restriction
               :code :registration-disabled))
 
-  (when-let [domains (cfg/get :registration-domain-whitelist)]
+  (when-let [domains (cf/get :registration-domain-whitelist)]
     (when-not (email-domain-in-whitelist? domains (:email params))
       (ex/raise :type :validation
                 :code :email-domain-is-not-allowed)))
@@ -150,7 +151,8 @@
   transaction is completed."
   [metrics]
   (fn []
-    ((get-in metrics [:definitions :profile-register]) :inc)))
+    (let [mobj (get-in metrics [:definitions :profile-register])]
+      ((::mtx/fn mobj) {:by 1}))))
 
 (defn register-profile
   [{:keys [conn tokens session metrics] :as cfg} {:keys [token] :as params}]
@@ -402,6 +404,7 @@
               {:password (derive-password password)}
               {:id id}))
 
+
 ;; --- MUTATION: Update Photo
 
 (declare update-profile-photo)
@@ -416,11 +419,13 @@
   [{: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)}})
+
     (let [profile (db/get-by-id conn :profile profile-id)
-          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                                     :mtype (:content-type file)}})
-          photo   (teams/upload-photo cfg params)
-          storage (assoc storage :conn conn)]
+          storage (media/configure-assets-storage storage conn)
+          cfg     (assoc cfg :storage storage)
+          photo   (teams/upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
       (when-let [id (:photo-id profile)]
@@ -453,7 +458,7 @@
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
-      (if (cfg/get :smtp-enabled)
+      (if (cf/get :smtp-enabled)
         (request-email-change cfg params)
         (change-email-inmediatelly cfg params)))))
 

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

@@ -117,11 +117,15 @@
 (s/def ::delete-project
   (s/keys :req-un [::id ::profile-id]))
 
+;; TODO: right now, we just don't allow delete default projects, in a
+;; future we need to ensure raise a correct exception signaling that
+;; this is not allowed.
+
 (sv/defmethod ::delete-project
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (proj/check-edition-permissions! conn profile-id id)
     (db/update! conn :project
                 {:deleted-at (dt/now)}
-                {:id id})
+                {:id id :is-default false})
     nil))

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

@@ -0,0 +1,67 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.rpc.mutations.share-link
+  "Share link related rpc mutation methods."
+  (:require
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc.queries.files :as files]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Helpers & Specs
+
+(s/def ::id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::flags (s/every ::us/string :kind set?))
+(s/def ::pages (s/every ::us/uuid :kind set?))
+
+;; --- Mutation: Create Share Link
+
+(declare create-share-link)
+
+(s/def ::create-share-link
+  (s/keys :req-un [::profile-id ::file-id ::flags]
+          :opt-un [::pages]))
+
+(sv/defmethod ::create-share-link
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (files/check-edition-permissions! conn profile-id file-id)
+    (create-share-link conn params)))
+
+(defn create-share-link
+  [conn {:keys [profile-id file-id pages flags]}]
+  (let [pages (db/create-array conn "uuid" pages)
+        flags (->> (map name flags)
+                   (db/create-array conn "text"))
+        slink (db/insert! conn :share-link
+                          {:id (uuid/next)
+                           :file-id file-id
+                           :flags flags
+                           :pages pages
+                           :owner-id profile-id})]
+    (-> slink
+        (update :pages db/decode-pgarray #{})
+        (update :flags db/decode-pgarray #{}))))
+
+;; --- Mutation: Delete Share Link
+
+(declare delete-share-link)
+
+(s/def ::delete-share-link
+  (s/keys :req-un [::profile-id ::id]))
+
+(sv/defmethod ::delete-share-link
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [slink (db/get-by-id conn :share-link id)]
+      (files/check-edition-permissions! conn profile-id (:file-id slink))
+      (db/delete! conn :share-link {:id id})
+      nil)))

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

@@ -125,6 +125,10 @@
 (s/def ::delete-team
   (s/keys :req-un [::profile-id ::id]))
 
+;; TODO: right now just don't allow delete default team, in future it
+;; should raise a speific exception for signal that this acction is
+;; not allowed.
+
 (sv/defmethod ::delete-team
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
@@ -135,7 +139,7 @@
 
       (db/update! conn :team
                   {:deleted-at (dt/now)}
-                  {:id id})
+                  {:id id :is-default false})
       nil)))
 
 
@@ -251,10 +255,12 @@
   (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)}})
 
     (let [team    (teams/retrieve-team conn profile-id team-id)
-          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                                     :mtype (:content-type file)}})
+          storage (media/configure-assets-storage storage conn)
+          cfg     (assoc cfg :storage storage)
           photo   (upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
@@ -263,8 +269,8 @@
 
       ;; Save new photo
       (db/update! conn :team
-              {:photo-id (:id photo)}
-              {:id team-id})
+                  {:photo-id (:id photo)}
+                  {:id team-id})
 
       (assoc team :photo-id (:id photo)))))
 

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

@@ -9,6 +9,7 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.metrics :as mtx]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
    [app.util.services :as sv]
@@ -42,7 +43,8 @@
   transaction is completed."
   [metrics]
   (fn []
-    ((get-in metrics [:definitions :profile-activation]) :inc)))
+    (let [mobj (get-in metrics [:definitions :profile-activation])]
+      ((::mtx/fn mobj) {:by 1}))))
 
 (defmethod process-token :verify-email
   [{:keys [conn session metrics] :as cfg} _ {:keys [profile-id] :as claims}]

backend/src/app/rpc/permissions.clj

@@ -37,6 +37,41 @@
            :is-admin false
            :can-edit false)))
 
+(defn make-edition-predicate-fn
+  "A simple factory for edition permission predicate functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (when-not (or (empty? rows)
+                    (not (or (some :can-edit rows)
+                             (some :is-admin rows)
+                             (some :is-owner rows))))
+        rows))))
+
+(defn make-read-predicate-fn
+  "A simple factory for read permission predicate functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (when (seq rows)
+        rows))))
+
+(defn make-check-fn
+  "Helper that converts a predicate permission function to a check
+  function (function that raises an exception)."
+  [pred]
+  (fn [& args]
+    (when-not (seq (apply pred args))
+      (ex/raise :type :not-found
+                :code :object-not-found
+                :hint "not found"))))
+
+
+;; TODO: the following functions are deprecated and replaced with the
+;; new ones. Should not be used.
+
 (defn make-edition-check-fn
   "A simple factory for edition permission check functions."
   [qfn]

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

@@ -9,7 +9,6 @@
    [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.rpc.permissions :as perms]
    [app.rpc.queries.projects :as projects]
@@ -62,16 +61,23 @@
 
 (defn- retrieve-file-permissions
   [conn profile-id file-id]
-  (db/exec! conn [sql:file-permissions
-                  file-id profile-id
-                  file-id profile-id
-                  file-id profile-id]))
+  (when (and profile-id file-id)
+    (db/exec! conn [sql:file-permissions
+                    file-id profile-id
+                    file-id profile-id
+                    file-id profile-id])))
+
+(def has-edit-permissions?
+  (perms/make-edition-predicate-fn retrieve-file-permissions))
+
+(def has-read-permissions?
+  (perms/make-read-predicate-fn retrieve-file-permissions))
 
 (def check-edition-permissions!
-  (perms/make-edition-check-fn retrieve-file-permissions))
+  (perms/make-check-fn has-edit-permissions?))
 
 (def check-read-permissions!
-  (perms/make-read-check-fn retrieve-file-permissions))
+  (perms/make-check-fn has-read-permissions?))
 
 
 ;; --- Query: Files search
@@ -175,7 +181,7 @@
 
 (defn- retrieve-data*
   [{:keys [storage] :as cfg} file]
-  (when-let [backend (simpl/resolve-backend storage (cf/get :fdata-storage-backend))]
+  (when-let [backend (simpl/resolve-backend storage (:data-backend file))]
     (simpl/get-object-bytes backend file)))
 
 (defn retrieve-data

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

@@ -92,11 +92,16 @@
 
     profile))
 
+(def ^:private sql:profile-by-email
+  "select p.* from profile as p
+    where p.email = ?
+      and (p.deleted_at is null or
+           p.deleted_at > now())")
+
 (defn retrieve-profile-data-by-email
   [conn email]
-  (try
-    (db/get-by-params conn :profile {:email (str/lower email)})
-    (catch Exception _e)))
+  (ex/ignoring
+   (db/exec-one! conn [sql:profile-by-email (str/lower email)])))
 
 ;; --- Attrs Helpers
 

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

@@ -14,24 +14,98 @@
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
+;; --- Query: View Only Bundle
+
+(defn- decode-share-link-row
+  [row]
+  (-> row
+      (update :flags db/decode-pgarray #{})
+      (update :pages db/decode-pgarray #{})))
+
+(defn- retrieve-project
+  [conn id]
+  (db/get-by-id conn :project id {:columns [:id :name :team-id]}))
+
+(defn- retrieve-share-link
+  [{:keys [conn]} file-id id]
+  (some-> (db/get-by-params conn :share-link
+                            {:id id :file-id file-id}
+                            {:check-not-found false})
+          (decode-share-link-row)))
+
+(defn- retrieve-bundle
+  [{:keys [conn] :as cfg} file-id]
+  (let [file    (files/retrieve-file cfg file-id)
+        project (retrieve-project conn (:project-id file))
+        libs    (files/retrieve-file-libraries cfg false file-id)
+        users   (teams/retrieve-users conn (:team-id project))
+
+        links   (->> (db/query conn :share-link {:file-id file-id})
+                     (mapv decode-share-link-row))
+
+        fonts   (db/query conn :team-font-variant
+                          {:team-id (:team-id project)
+                           :deleted-at nil})]
+    {:file file
+     :users users
+     :fonts fonts
+     :project project
+     :share-links links
+     :libraries libs}))
+
+(s/def ::file-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::share-id ::us/uuid)
+
+(s/def ::view-only-bundle
+  (s/keys :req-un [::file-id] :opt-un [::profile-id ::share-id]))
+
+(sv/defmethod ::view-only-bundle {:auth false}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [cfg    (assoc cfg :conn conn)
+          bundle (retrieve-bundle cfg file-id)
+          slink  (retrieve-share-link cfg file-id share-id)]
+
+      ;; When we have neither profile nor share, we just return a not
+      ;; found response to the user.
+      (when (and (not profile-id)
+                 (not slink))
+        (ex/raise :type :not-found
+                  :code :object-not-found))
+
+      ;; When we have only profile, we need to check read permissiones
+      ;; on file.
+      (when (and profile-id (not slink))
+        (files/check-read-permissions! conn profile-id file-id))
+
+      (cond-> bundle
+        ;; If we have current profile, put
+        (some? profile-id)
+        (as-> $ (let [edit? (boolean (files/has-edit-permissions? conn profile-id file-id))
+                      read? (boolean (files/has-read-permissions? conn profile-id file-id))]
+                  (-> (assoc $ :permissions {:read read? :edit edit?})
+                      (cond-> (not edit?) (dissoc :share-links)))))
+
+        (some? slink)
+        (assoc :share slink)
+
+        (and (some? slink)
+             (not (contains? (:flags slink) "view-all-pages")))
+        (update-in [:file :data] (fn [data]
+                                   (let [allowed-pages (:pages slink)]
+                                     (-> data
+                                         (update :pages (fn [pages] (filterv #(contains? allowed-pages %) pages)))
+                                         (update :pages-index (fn [index] (select-keys index allowed-pages)))))))))))
+
 ;; --- Query: Viewer Bundle (by Page ID)
 
+;; DEPRECATED: should be removed in 1.9.x
+
 (declare check-shared-token!)
 (declare retrieve-shared-token)
 
-(def ^:private
-  sql:project
-  "select p.id, p.name, p.team_id
-     from project as p
-    where p.id = ?
-      and p.deleted_at is null")
-
-(defn- retrieve-project
-  [conn id]
-  (db/exec-one! conn [sql:project id]))
-
 (s/def ::id ::us/uuid)
-(s/def ::file-id ::us/uuid)
 (s/def ::page-id ::us/uuid)
 (s/def ::token ::us/string)
 
@@ -81,6 +155,3 @@
   [conn file-id page-id]
   (let [sql "select * from file_share_token where file_id=? and page_id=?"]
     (db/exec-one! conn [sql file-id page-id])))
-
-
-

backend/src/app/storage.clj

@@ -28,8 +28,6 @@
 ;; Storage Module State
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::backend ::us/keyword)
-
 (s/def ::s3 ::ss3/backend)
 (s/def ::fs ::sfs/backend)
 (s/def ::db ::sdb/backend)
@@ -42,7 +40,7 @@
                    :db ::sdb/backend))))
 
 (defmethod ig/pre-init-spec ::storage [_]
-  (s/keys :req-un [::backend ::wrk/executor ::db/pool ::backends]))
+  (s/keys :req-un [::wrk/executor ::db/pool ::backends]))
 
 (defmethod ig/prep-key ::storage
   [_ {:keys [backends] :as cfg}]
@@ -55,7 +53,7 @@
       (assoc :backends (d/without-nils backends))))
 
 (s/def ::storage
-  (s/keys :req-un [::backends ::wrk/executor ::db/pool ::backend]))
+  (s/keys :req-un [::backends ::wrk/executor ::db/pool]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Database Objects

backend/src/app/tasks/delete_object.clj

@@ -60,7 +60,7 @@
 
 (defmethod handle-deletion :team-font-variant
   [{:keys [conn storage]} {:keys [id] :as props}]
-  (let [font    (db/get-by-id conn :team-font-variant id {:uncheked true})
+  (let [font    (db/get-by-id conn :team-font-variant id {:check-not-found false})
         storage (assoc storage :conn conn)]
     (when (:deleted-at font)
       (db/delete! conn :team-font-variant {:id id})

backend/src/app/tasks/file_media_gc.clj

@@ -64,16 +64,21 @@
   (comp
    (map :objects)
    (mapcat vals)
-   (filter #(= :image (:type %)))
-   (map :metadata)
-   (map :id)))
+   (map (fn [{:keys [type] :as obj}]
+          (case type
+            :path (get-in obj [:fill-image :id])
+            :image (get-in obj [:metadata :id])
+            nil)))
+   (filter uuid?)))
 
 (defn- collect-used-media
   [data]
+  (let [pages (concat
+               (vals (:pages-index data))
+               (vals (:components data)))]
   (-> #{}
-      (into collect-media-xf (vals (:pages-index data)))
-      (into collect-media-xf (vals (:components data)))
-      (into (keys (:media data)))))
+      (into collect-media-xf pages)
+      (into (keys (:media data))))))
 
 (defn- process-file
   [{:keys [conn] :as cfg} {:keys [id data age] :as file}]

backend/test/app/services_viewer_test.clj

@@ -16,18 +16,18 @@
 (t/use-fixtures :each th/database-reset)
 
 (t/deftest retrieve-bundle
-  (let [prof    (th/create-profile* 1 {:is-active true})
-        prof2   (th/create-profile* 2 {:is-active true})
-        team-id (:default-team-id prof)
-        proj-id (:default-project-id prof)
+  (let [prof     (th/create-profile* 1 {:is-active true})
+        prof2    (th/create-profile* 2 {:is-active true})
+        team-id  (:default-team-id prof)
+        proj-id  (:default-project-id prof)
 
-        file    (th/create-file* 1 {:profile-id (:id prof)
-                                    :project-id proj-id
-                                    :is-shared false})
-        token   (atom nil)]
+        file     (th/create-file* 1 {:profile-id (:id prof)
+                                     :project-id proj-id
+                                     :is-shared false})
+        share-id (atom nil)]
 
     (t/testing "authenticated with page-id"
-      (let [data {::th/type :viewer-bundle
+      (let [data {::th/type :view-only-bundle
                   :profile-id (:id prof)
                   :file-id (:id file)
                   :page-id (get-in file [:data :pages 0])}
@@ -38,64 +38,67 @@
         (t/is (nil? (:error out)))
 
         (let [result (:result out)]
-          (t/is (contains? result :token))
-          (t/is (contains? result :page))
+          (t/is (contains? result :share-links))
+          (t/is (contains? result :permissions))
+          (t/is (contains? result :libraries))
           (t/is (contains? result :file))
           (t/is (contains? result :project)))))
 
     (t/testing "generate share token"
-      (let [data {::th/type :create-file-share-token
+      (let [data {::th/type :create-share-link
                   :profile-id (:id prof)
                   :file-id (:id file)
-                  :page-id (get-in file [:data :pages 0])}
+                  :pages #{(get-in file [:data :pages 0])}
+                  :flags #{}}
             out  (th/mutation! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
         (let [result (:result out)]
-          (t/is (string? (:token result)))
-          (reset! token (:token result)))))
+          (t/is (uuid? (:id result)))
+          (reset! share-id (:id result)))))
 
     (t/testing "not authenticated with page-id"
-      (let [data {::th/type :viewer-bundle
+      (let [data {::th/type :view-only-bundle
                   :profile-id (:id prof2)
                   :file-id (:id file)
                   :page-id (get-in file [:data :pages 0])}
             out  (th/query! data)]
 
         ;; (th/print-result! out)
-        (let [error (:error out)
+        (let [error      (:error out)
               error-data (ex-data error)]
           (t/is (th/ex-info? error))
           (t/is (= (:type error-data) :not-found))
           (t/is (= (:code error-data) :object-not-found)))))
 
-    ;; (t/testing "authenticated with token & profile"
-    ;;   (let [data {::sq/type :viewer-bundle
-    ;;               :profile-id (:id prof2)
-    ;;               :token @token
-    ;;               :file-id (:id file)
-    ;;               :page-id (get-in file [:data :pages 0])}
-    ;;         out  (th/try-on! (sq/handle data))]
+    (t/testing "authenticated with token & profile"
+      (let [data {::th/type :view-only-bundle
+                  :profile-id (:id prof2)
+                  :share-id @share-id
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+            out  (th/query! data)]
 
-    ;;     ;; (th/print-result! out)
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
 
-    ;;     (let [result (:result out)]
-    ;;       (t/is (contains? result :page))
-    ;;       (t/is (contains? result :file))
-    ;;       (t/is (contains? result :project)))))
+        (let [result (:result out)]
+          (t/is (contains? result :share))
+          (t/is (contains? result :file))
+          (t/is (contains? result :project)))))
 
-    ;; (t/testing "authenticated with token"
-    ;;   (let [data {::sq/type :viewer-bundle
-    ;;               :token @token
-    ;;               :file-id (:id file)
-    ;;               :page-id (get-in file [:data :pages 0])}
-    ;;         out  (th/try-on! (sq/handle data))]
+    (t/testing "authenticated with token"
+      (let [data {::th/type :view-only-bundle
+                  :share-id @share-id
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+            out  (th/query! data)]
 
-    ;;     ;; (th/print-result! out)
+        ;; (th/print-result! out)
+        (let [result (:result out)]
+          (t/is (contains? result :file))
+          (t/is (contains? result :share))
+          (t/is (contains? result :project)))))
 
-    ;;     (let [result (:result out)]
-    ;;       (t/is (contains? result :page))
-    ;;       (t/is (contains? result :file))
-    ;;       (t/is (contains? result :project)))))
     ))

backend/test/app/test_helpers.clj

@@ -228,9 +228,12 @@
   ([params] (update-file* *pool* params))
   ([conn {:keys [file-id changes session-id profile-id revn]
           :or {session-id (uuid/next) revn 0}}]
-   (let [file   (db/get-by-id conn :file file-id)
-         msgbus (:app.msgbus/msgbus *system*)]
-     (#'files/update-file {:conn conn :msgbus msgbus}
+   (let [file    (db/get-by-id conn :file file-id)
+         msgbus  (:app.msgbus/msgbus *system*)
+         metrics (:app.metrics/metrics *system*)]
+     (#'files/update-file {:conn conn
+                           :msgbus msgbus
+                           :metrics metrics}
                           {:file file
                            :revn revn
                            :changes changes

common/src/app/common/flags.cljc

@@ -0,0 +1,32 @@
+;; 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.flags
+  "Flags parsing algorithm."
+  (:require
+   [cuerdas.core :as str]))
+
+(defn parse
+  [default flags]
+  (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))))
+
+            (str/starts-with? sname "disable-")
+            (recur (rest flags)
+                   (disj result (keyword (subs sname 8))))
+
+            :else
+            (recur (rest flags) result)))))))
+
+

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

@@ -487,6 +487,7 @@
                                             (d/parse-double)
                                             (* (get-in modifiers [:resize-vector :x] 1))
                                             (* (get-in modifiers [:resize-vector-2 :x] 1))
+                                            (mth/precision 2)
                                             (str))]
                           (attrs/merge attrs {:font-size font-size})))]
       (update shape :content #(txt/transform-nodes
@@ -597,10 +598,8 @@
                         (assoc :resize-origin (:resize-origin parent-modifiers)
                                :resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
 
-                        (and (:resize-vector-2 parent-modifiers)
-                             (not (mth/close? (:x (:resize-vector-2 parent-modifiers)) 1)))
-                        (assoc :resize-origin-2 (:resize-origin-2 parent-modifiers)
-                               :resize-vector-2 (gpt/point (:x (:resize-vector-2 parent-modifiers)) 1))
+                        ;; resize-vector-2 is always for vertical modifiers, so no need to
+                        ;; check it here.
 
                         (:displacement parent-modifiers)
                         (assoc :displacement
@@ -654,10 +653,12 @@
                         (assoc :resize-origin (:resize-origin parent-modifiers)
                                :resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers))))
 
+                        ;; If there is a resize-vector-2, this means that we come from a recursive
+                        ;; call, and the resize-vector has no vertical data, so we may override it.
                         (and (:resize-vector-2 parent-modifiers)
                              (not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
-                        (assoc :resize-origin-2 (:resize-origin-2 parent-modifiers)
-                               :resize-vector-2 (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
+                        (assoc :resize-origin (:resize-origin-2 parent-modifiers)
+                               :resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
 
                         (:displacement parent-modifiers)
                         (assoc :displacement

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

@@ -15,6 +15,20 @@
    [app.common.pages.spec :as spec]
    [app.common.spec :as us]))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Specific helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- without-obj
+  "Clear collection from specified obj and without nil values."
+  [coll o]
+  (into [] (filter #(not= % o)) coll))
+
+(defn vec-without-nils
+  [coll]
+  (into [] (remove nil?) coll))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Page Transformation Changes
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -54,45 +68,50 @@
                           (assoc data :options (d/dissoc-in (:options data) path)))))))
 
 (defmethod process-change :add-obj
-  [data {:keys [id obj page-id component-id frame-id parent-id
-                index ignore-touched]}]
-  (letfn [(update-fn [data]
-            (let [parent-id (or parent-id frame-id)
-                  objects   (:objects data)
-                  obj (assoc obj
-                             :frame-id frame-id
-                             :parent-id parent-id
-                             :id id)]
-              (if (and (or (nil? parent-id) (contains? objects parent-id))
-                       (or (nil? frame-id) (contains? objects frame-id)))
-                (-> data
-                    (update :objects assoc id obj)
-                    (update-in [:objects parent-id :shapes]
-                               (fn [shapes]
-                                 (let [shapes (or shapes [])]
-                                   (cond
-                                     (some #{id} shapes)
-                                     shapes
+  [data {:keys [id obj page-id component-id frame-id parent-id index ignore-touched]}]
+  (letfn [(update-parent-shapes [shapes]
+            ;; Ensure that shapes is always a vector.
+            (let [shapes (into [] shapes)]
+              (cond
+                (some #{id} shapes)
+                shapes
 
-                                     (nil? index)
-                                     (if (= :frame (:type obj))
-                                       (d/concat [id] shapes)
-                                       (conj shapes id))
+                (nil? index)
+                (if (= :frame (:type obj))
+                  (into [id] shapes)
+                  (conj shapes id))
 
-                                     :else
-                                     (cph/insert-at-index shapes index [id])))))
+                :else
+                (cph/insert-at-index shapes index [id]))))
+
+          (update-parent [parent]
+            (-> parent
+                (update :shapes update-parent-shapes)
+                (update :shapes vec-without-nils)
+                (cond-> (and (:shape-ref parent)
+                             (not= (:id parent) frame-id)
+                             (not ignore-touched))
+                  (-> (update :touched cph/set-touched-group :shapes-group)
+                      (dissoc :remote-synced?)))))
+
+          (update-objects [objects parent-id]
+            (if (and (or (nil? parent-id) (contains? objects parent-id))
+                     (or (nil? frame-id) (contains? objects frame-id)))
+              (-> objects
+                  (assoc id (-> obj
+                                (assoc :frame-id frame-id)
+                                (assoc :parent-id parent-id)
+                                (assoc :id id)))
+                  (update parent-id update-parent))
+              objects))
+
+          (update-container [data]
+            (let [parent-id (or parent-id frame-id)]
+              (update data :objects update-objects parent-id)))]
 
-                    (cond-> (and (:shape-ref (get-in data [:objects parent-id]))
-                                 (not= parent-id frame-id)
-                                 (not ignore-touched))
-                      (->
-                        (update-in [:objects parent-id :touched]
-                                   cph/set-touched-group :shapes-group)
-                        (d/dissoc-in [:objects parent-id :remote-synced?]))))
-                data)))]
     (if page-id
-      (d/update-in-when data [:pages-index page-id] update-fn)
-      (d/update-in-when data [:components component-id] update-fn))))
+      (d/update-in-when data [:pages-index page-id] update-container)
+      (d/update-in-when data [:components component-id] update-container))))
 
 (defmethod process-change :mod-obj
   [data {:keys [id page-id component-id operations]}]
@@ -107,32 +126,27 @@
 
 (defmethod process-change :del-obj
   [data {:keys [page-id component-id id ignore-touched]}]
-  (letfn [(delete-object [objects id]
+  (letfn [(delete-from-parent [parent]
+            (let [parent (update parent :shapes without-obj id)]
+              (cond-> parent
+                (and (:shape-ref parent)
+                     (not ignore-touched))
+                (-> (update :touched cph/set-touched-group :shapes-group)
+                    (dissoc :remote-synced?)))))
+
+          (delete-from-objects [objects]
             (if-let [target (get objects id)]
-              (let [parent-id (cph/get-parent id objects)
-                    frame-id  (:frame-id target)
-                    parent    (get objects parent-id)
-                    objects   (dissoc objects id)]
-                (cond-> objects
-                  (and (not= parent-id frame-id)
-                       (#{:group :svg-raw} (:type parent)))
-                  (update-in [parent-id :shapes] (fn [s] (filterv #(not= % id) s)))
-
-                  (and (:shape-ref parent) (not ignore-touched))
-                  (->
-                    (update-in [parent-id :touched] cph/set-touched-group :shapes-group)
-                    (d/dissoc-in [parent-id :remote-synced?]))
-
-                  (contains? objects frame-id)
-                  (update-in [frame-id :shapes] (fn [s] (filterv #(not= % id) s)))
-
-                  (seq (:shapes target))   ; Recursive delete all
-                                           ; dependend objects
-                  (as-> $ (reduce delete-object $ (:shapes target)))))
+              (let [parent-id (or (:parent-id target)
+                                  (:frame-id target))
+                    children  (cph/get-children id objects)]
+                (-> (reduce dissoc objects children)
+                    (dissoc id)
+                    (d/update-when parent-id delete-from-parent)))
               objects))]
+
     (if page-id
-      (d/update-in-when data [:pages-index page-id :objects] delete-object id)
-      (d/update-in-when data [:components component-id :objects] delete-object id))))
+      (d/update-in-when data [:pages-index page-id :objects] delete-from-objects)
+      (d/update-in-when data [:components component-id :objects] delete-from-objects))))
 
 ;; reg-objects operation "regenerates" the geometry and selrect of the parent groups
 (defmethod process-change :reg-objects
@@ -191,25 +205,24 @@
               (insert-items prev-shapes index shapes)
               ;; For masked groups, the first shape is the mask
               ;; and it cannot be moved.
-              (let [mask-id (first prev-shapes)
-                    other-ids (rest prev-shapes)
-                    not-mask-shapes (strip-id shapes mask-id)
-                    new-index (if (nil? index) nil (max (dec index) 0))
-                    new-shapes (insert-items other-ids new-index not-mask-shapes)]
+              (let [mask-id         (first prev-shapes)
+                    other-ids       (rest prev-shapes)
+                    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))))
 
-          (strip-id [coll id]
-            (filterv #(not= % id) coll))
-
           (add-to-parent [parent index shapes]
-            (cond-> parent
-              true
-              (update :shapes check-insert-items parent index shapes)
-
-              (and (:shape-ref parent) (= (:type parent) :group) (not ignore-touched))
-              (->
-                (update :touched cph/set-touched-group :shapes-group)
-                (dissoc :remote-synced?))))
+            (let [parent (-> parent
+                             (update :shapes check-insert-items parent index shapes)
+                             ;; We need to ensure that no `nil` in the
+                             ;; shapes list after adding all the
+                             ;; incoming shapes to the parent.
+                             (update :shapes vec-without-nils))]
+              (cond-> parent
+                (and (:shape-ref parent) (= (:type parent) :group) (not ignore-touched))
+                (-> (update :touched cph/set-touched-group :shapes-group)
+                    (dissoc :remote-synced?)))))
 
           (remove-from-old-parent [cpindex objects shape-id]
             (let [prev-parent-id (get cpindex shape-id)]
@@ -217,22 +230,19 @@
               ;; the new destination target parent id.
               (if (= prev-parent-id parent-id)
                 objects
-                (let [sid shape-id
-                      pid prev-parent-id
-                      obj (get objects pid)
+                (let [sid        shape-id
+                      pid        prev-parent-id
+                      obj        (get objects pid)
                       component? (and (:shape-ref obj)
                                       (= (:type obj) :group)
                                       (not ignore-touched))]
 
                   (-> objects
-                      (d/update-in-when [pid :shapes] strip-id sid)
-
-                      (cond-> component?
-                        (d/update-when
-                         pid
-                         #(-> %
-                              (update :touched cph/set-touched-group :shapes-group)
-                              (dissoc :remote-synced?)))))))))
+                      (d/update-in-when [pid :shapes] without-obj sid)
+                      (d/update-in-when [pid :shapes] vec-without-nils)
+                      (cond-> component? (d/update-when pid #(-> %
+                                                                 (update :touched cph/set-touched-group :shapes-group)
+                                                                 (dissoc :remote-synced?)))))))))
 
           (update-parent-id [objects id]
             (-> objects
@@ -240,8 +250,7 @@
 
           ;; Updates the frame-id references that might be outdated
           (assign-frame-id [frame-id objects id]
-            (let [objects (-> objects
-                              (d/update-when id assoc :frame-id frame-id))
+            (let [objects (d/update-when objects id assoc :frame-id frame-id)
                   obj     (get objects id)]
               (cond-> objects
                 ;; If we moving frame, the parent frame is the root
@@ -293,23 +302,24 @@
 
 (defmethod process-change :add-page
   [data {:keys [id name page]}]
-  (cond
-    (and (string? name) (uuid? id))
-    (let [page (assoc init/empty-page-data
-                      :id id
-                      :name name)]
-      (-> data
-          (update :pages conj id)
-          (update :pages-index assoc id page)))
-
-    (map? page)
-    (-> data
-        (update :pages conj (:id page))
-        (update :pages-index assoc (:id page) page))
-
-    :else
+  (when (and id name page)
     (ex/raise :type :conflict
-              :hint "name or page should be provided, never both")))
+              :hint "name or page should be provided, never both"))
+  (letfn [(conj-if-not-exists [pages id]
+            (cond-> pages
+              (not (d/seek #(= % id) pages))
+              (conj id)))]
+    (if (and (string? name) (uuid? id))
+      (let [page (assoc init/empty-page-data
+                        :id id
+                        :name name)]
+        (-> data
+            (update :pages conj-if-not-exists id)
+            (update :pages-index assoc id page)))
+
+      (-> data
+          (update :pages conj-if-not-exists (:id page))
+          (update :pages-index assoc (:id page) page)))))
 
 (defmethod process-change :mod-page
   [data {:keys [id name]}]

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

@@ -8,7 +8,7 @@
   (:require
    [app.common.uuid :as uuid]))
 
-(def file-version 8)
+(def file-version 11)
 (def default-color "#b1b2b5") ;; $color-gray-20
 (def root uuid/zero)
 
@@ -37,6 +37,8 @@
    :stroke-style          :stroke-group
    :stroke-width          :stroke-group
    :stroke-alignment      :stroke-group
+   :stroke-cap-start      :stroke-group
+   :stroke-cap-end        :stroke-group
    :rx                    :radius-group
    :ry                    :radius-group
    :r1                    :radius-group

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

@@ -99,19 +99,20 @@
 
 ;; Implemented with transient for performance
 (defn get-children
-  "Retrieve all children ids recursively for a given object"
+  "Retrieve all children ids recursively for a given object. The
+  children's order will be breadth first."
   [id objects]
 
-  (loop [result (transient [])
+  (loop [result  (transient [])
          pending (transient [])
-         next id]
+         next    id]
     (let [children (get-in objects [next :shapes] [])
           [result pending]
           ;; Iterate through children and add them to the result
           ;; also add them in pending to check for their children
           (loop [result result
                  pending pending
-                 current (first children)
+                 current  (first children)
                  children (rest children)]
             (if current
               (recur (conj! result current)
@@ -213,7 +214,7 @@
             (if (some #{id} acc)
               acc
               (conj acc id)))
-          prev-ids
+          (vec prev-ids)
           ids))
 
 (defn select-toplevel-shapes

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

@@ -15,7 +15,7 @@
 
 (def empty-page-data
   {:options {}
-   :name "Page"
+   :name "Page-1"
    :objects
    {root
     {:id root
@@ -38,7 +38,7 @@
 
 (def ^:private minimal-shapes
   [{:type :rect
-    :name "Rect"
+    :name "Rect-1"
     :fill-color default-color
     :fill-opacity 1
     :stroke-style :none
@@ -52,7 +52,7 @@
    {:type :image}
 
    {:type :circle
-    :name "Circle"
+    :name "Circle-1"
     :fill-color default-color
     :fill-opacity 1
     :stroke-style :none
@@ -62,7 +62,7 @@
     :stroke-opacity 0}
 
    {:type :path
-    :name "Path"
+    :name "Path-1"
     :stroke-style :solid
     :stroke-alignment :center
     :stroke-width 2
@@ -70,7 +70,7 @@
     :stroke-opacity 1}
 
    {:type :frame
-    :name "Artboard"
+    :name "Artboard-1"
     :fill-color "#ffffff"
     :fill-opacity 1
     :stroke-style :none
@@ -80,7 +80,7 @@
     :stroke-opacity 0}
 
    {:type :text
-    :name "Text"
+    :name "Text-1"
     :content nil}
 
    {:type :svg-raw}])

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

@@ -222,3 +222,49 @@
         (update :pages-index #(d/mapm clean-container %))
         (d/update-when :components #(d/mapm clean-container %)))))
 
+(defmethod migrate 9
+  [data]
+  (letfn [(find-empty-groups [objects]
+            (->> (vals objects)
+                 (filter (fn [shape]
+                           (and (= :group (:type shape))
+                                (or (empty? (:shapes shape))
+                                    (every? (fn [child-id]
+                                              (not (contains? objects child-id)))
+                                            (:shapes shape))))))
+                 (map :id)))
+
+          (calculate-changes [[page-id page]]
+            (let [objects (:objects page)
+                  eids    (find-empty-groups objects)]
+
+              (map (fn [id]
+                     {:type :del-obj
+                      :page-id page-id
+                      :id id})
+                   eids)))]
+
+    (loop [data data]
+      (let [changes (mapcat calculate-changes (:pages-index data))]
+        (if (seq changes)
+          (recur (cp/process-changes data changes))
+          data)))))
+
+(defmethod migrate 10
+  [data]
+  (letfn [(update-page [_ page]
+            (d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))]
+    (update data :pages-index #(d/mapm update-page %))))
+
+(defmethod migrate 11
+  [data]
+  (letfn [(update-object [objects _id shape]
+            (if (= :frame (:type shape))
+              (d/update-when shape :shapes (fn [shapes]
+                                             (filterv (fn [id] (contains? objects id)) shapes)))
+              shape))
+
+          (update-page [_ page]
+            (update page :objects #(d/mapm (partial update-object %) %)))]
+
+    (update data :pages-index #(d/mapm update-page %))))

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

@@ -10,6 +10,7 @@
    [app.common.geom.point :as gpt]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [clojure.set :as set]
    [clojure.spec.alpha :as s]))
 
 ;; --- Specs
@@ -254,6 +255,17 @@
 (s/def :internal.shape/stroke-color-ref-id (s/nilable uuid?))
 (s/def :internal.shape/stroke-opacity ::safe-number)
 (s/def :internal.shape/stroke-style #{:solid :dotted :dashed :mixed :none :svg})
+
+(def stroke-caps-line #{:round :square})
+(def stroke-caps-marker #{:line-arrow :triangle-arrow :square-marker :circle-marker :diamond-marker})
+(def stroke-caps (set/union stroke-caps-line stroke-caps-marker))
+(s/def :internal.shape/stroke-cap-start stroke-caps)
+(s/def :internal.shape/stroke-cap-end stroke-caps)
+
+(defn has-caps?
+  [shape]
+  (= (:type shape) :path))
+
 (s/def :internal.shape/stroke-width ::safe-number)
 (s/def :internal.shape/stroke-alignment #{:center :inner :outer})
 (s/def :internal.shape/text-align #{"left" "right" "center" "justify"})
@@ -342,6 +354,8 @@
                    :internal.shape/stroke-style
                    :internal.shape/stroke-width
                    :internal.shape/stroke-alignment
+                   :internal.shape/stroke-cap-start
+                   :internal.shape/stroke-cap-end
                    :internal.shape/text-align
                    :internal.shape/transform
                    :internal.shape/transform-inverse

common/src/app/common/text.cljc

@@ -64,7 +64,8 @@
 
 (defn ^boolean is-text-node?
   [node]
-  (string? (:text node)))
+  (and (string? (:text node))
+       (not= (:text node) "")))
 
 (defn ^boolean is-paragraph-node?
   [node]

docker/devenv/Dockerfile

@@ -3,10 +3,10 @@ LABEL maintainer="Andrey Antukh <niwi@niwi.nz>"
 
 ARG DEBIAN_FRONTEND=noninteractive
 
-ENV NODE_VERSION=v14.17.2 \
-    CLOJURE_VERSION=1.10.3.882 \
-    CLJKONDO_VERSION=2021.06.18 \
-    BABASHKA_VERSION=0.4.6 \
+ENV NODE_VERSION=v14.17.5 \
+    CLOJURE_VERSION=1.10.3.933 \
+    CLJKONDO_VERSION=2021.07.28 \
+    BABASHKA_VERSION=0.5.1 \
     LANG=en_US.UTF-8 \
     LC_ALL=en_US.UTF-8
 
@@ -44,6 +44,7 @@ RUN set -ex; \
         python \
         build-essential \
         imagemagick \
+        ghostscript \
         netpbm \
         potrace \
         webp \
@@ -97,6 +98,15 @@ RUN set -ex; \
     ; \
     rm -rf /var/lib/apt/lists/*;
 
+RUN set -x; \
+    apt-get -qq update; \
+    curl -LfsSo /tmp/chrome.deb https://dl.google.com/linux/direct/google-chrome-stable_current_amd64.deb; \
+    dpkg -i /tmp/chrome.deb; \
+    apt-get -fy install; \
+    rm -rf /var/lib/apt/lists/*; \
+    rm -rf /tmp/chrome.deb;
+
+
 RUN set -ex; \
     curl -LfsSo /tmp/openjdk.tar.gz https://github.com/AdoptOpenJDK/openjdk16-binaries/releases/download/jdk-16.0.1%2B9/OpenJDK16U-jdk_x64_linux_hotspot_16.0.1_9.tar.gz; \
     mkdir -p /usr/lib/jvm/openjdk16; \

docker/devenv/docker-compose.yaml

@@ -92,6 +92,7 @@ services:
     ports:
       - "1080:1080"
 
+  # https://github.com/rroemhild/docker-test-openldap
   ldap:
     image: rroemhild/test-openldap:2.1
     expose:

docker/gitpod/Dockerfile

@@ -9,6 +9,7 @@ FROM gitpod/workspace-postgres
 RUN set -ex; \
     brew install redis; \
     brew install imagemagick; \
+    brew install ghostscript; \
     brew install mailhog; \
     brew install openldap; \
     sudo mkdir -p /var/log/nginx; \

docker/images/Dockerfile.exporter

@@ -1,11 +1,12 @@
-FROM ubuntu:20.04
+FROM debian:bullseye
 LABEL maintainer="Andrey Antukh <niwi@niwi.nz>"
 
 ARG DEBIAN_FRONTEND=noninteractive
 
 ENV LANG=en_US.UTF-8 \
     LC_ALL=en_US.UTF-8 \
-    NODE_VERSION=v14.16.0
+    NODE_VERSION=v14.17.5 \
+    PENPOT_BROWSER_EXECUTABLE_PATH=/usr/bin/chromium
 
 RUN set -ex; \
     mkdir -p /etc/resolvconf/resolv.conf.d; \
@@ -20,6 +21,7 @@ RUN set -ex; \
     apt-get -qq update; \
     apt-get -qqy install \
         imagemagick \
+        ghostscript \
         netpbm \
         potrace \
         gconf-service \
@@ -55,9 +57,9 @@ RUN set -ex; \
         libxss1 \
         libxtst6 \
         fonts-liberation \
-        libappindicator1 \
         libnss3 \
         libgbm1 \
+        chromium \
     ; \
     rm -rf /var/lib/apt/lists/*;
 

docker/images/config.env

@@ -13,8 +13,8 @@ PENPOT_REDIS_URI=redis://penpot-redis/0
 # can be configured to store in AWS S3 or completely in de the database.
 # Storing in the database makes the backups more easy but will make access to
 # media less performant.
-PENPOT_STORAGE_BACKEND=fs
-PENPOT_STORAGE_FS_DIRECTORY=/opt/data/assets
+ASSETS_STORAGE_BACKEND=assets-fs
+PENPOT_STORAGE_ASSETS_FS_DIRECTORY=/opt/data/assets
 
 # Telemetry. When enabled, a periodical process will send anonymous data about
 # this instance. Telemetry data will enable us to learn on how the application
@@ -35,17 +35,13 @@ PENPOT_SMTP_DEFAULT_REPLY_TO=no-reply@example.com
 # PENPOT_SMTP_TLS=true
 # PENPOT_SMTP_SSL=false
 
-# Enable or disable external user registration process.
-PENPOT_REGISTRATION_ENABLED=true
+# Feature flags. Right now they are only affect frontend, but in
+# future release they will affect to both backend and frontend.
+PENPOT_FLAGS="enable-registration enable-demo-users"
 
 # Comma separated list of allowed domains to register. Empty to allow all.
 # PENPOT_REGISTRATION_DOMAIN_WHITELIST=""
 
-# Penpot comes with the facility to create quick demo users that are
-# automatically deleted after some time. This settings enables or disables the
-# creation of demo users.
-PENPOT_ALLOW_DEMO_USERS=true
-
 ## Authentication providers
 
 # Google

docker/images/files/nginx-entrypoint.sh

@@ -9,37 +9,6 @@ log() {
 ## App Frontend config
 #########################################
 
-
-update_public_uri() {
-  if [ -n "$PENPOT_PUBLIC_URI" ]; then
-    log "Updating Public URI: $PENPOT_PUBLIC_URI"
-    sed -i \
-      -e "s|^//var penpotPublicURI = \".*\";|var penpotPublicURI = \"$PENPOT_PUBLIC_URI\";|g" \
-      "$1"
-  fi
-}
-
-
-update_demo_warning() {
-  if [ -n "$PENPOT_DEMO_WARNING" ]; then
-    log "Updating Demo Warning: $PENPOT_DEMO_WARNING"
-    sed -i \
-      -e "s|^//var penpotDemoWarning = .*;|var penpotDemoWarning = $PENPOT_DEMO_WARNING;|g" \
-      "$1"
-  fi
-}
-
-
-update_allow_demo_users() {
-  if [ -n "$PENPOT_ALLOW_DEMO_USERS" ]; then
-    log "Updating Allow Demo Users: $PENPOT_ALLOW_DEMO_USERS"
-    sed -i \
-      -e "s|^//var penpotAllowDemoUsers = .*;|var penpotAllowDemoUsers = $PENPOT_ALLOW_DEMO_USERS;|g" \
-      "$1"
-  fi
-}
-
-
 update_google_client_id() {
   if [ -n "$PENPOT_GOOGLE_CLIENT_ID" ]; then
     log "Updating Google Client Id: $PENPOT_GOOGLE_CLIENT_ID"
@@ -78,6 +47,7 @@ update_oidc_client_id() {
   fi
 }
 
+# DEPRECATED
 update_login_with_ldap() {
   if [ -n "$PENPOT_LOGIN_WITH_LDAP" ]; then
     log "Updating Login with LDAP: $PENPOT_LOGIN_WITH_LDAP"
@@ -87,7 +57,7 @@ update_login_with_ldap() {
   fi
 }
 
-
+# DEPRECATED
 update_registration_enabled() {
   if [ -n "$PENPOT_REGISTRATION_ENABLED" ]; then
     log "Updating Registration Enabled: $PENPOT_REGISTRATION_ENABLED"
@@ -97,14 +67,6 @@ update_registration_enabled() {
   fi
 }
 
-update_analytics_enabled() {
-  if [ -n "$PENPOT_ANALYTICS_ENABLED" ]; then
-    sed -i \
-      -e "s|^//var penpotAnalyticsEnabled = .*;|var penpotAnalyticsEnabled = $PENPOT_ANALYTICS_ENABLED;|g" \
-      "$1"
-  fi
-}
-
 update_flags() {
   if [ -n "$PENPOT_FLAGS" ]; then
     sed -i \
@@ -113,15 +75,11 @@ update_flags() {
   fi
 }
 
-update_public_uri /var/www/app/js/config.js
-update_demo_warning /var/www/app/js/config.js
-update_allow_demo_users /var/www/app/js/config.js
 update_google_client_id /var/www/app/js/config.js
 update_gitlab_client_id /var/www/app/js/config.js
 update_github_client_id /var/www/app/js/config.js
 update_oidc_client_id /var/www/app/js/config.js
 update_login_with_ldap /var/www/app/js/config.js
 update_registration_enabled /var/www/app/js/config.js
-update_analytics_enabled /var/www/app/js/config.js
 update_flags /var/www/app/js/config.js
 exec "$@";

exporter/deps.edn

@@ -4,7 +4,7 @@
   binaryage/devtools  {:mvn/version "RELEASE"}
   metosin/reitit-core {:mvn/version "0.5.13"}
   lambdaisland/glogi  {:mvn/version "1.0.106"}
-  funcool/beicon      {:mvn/version "2021.04.29-0"}
+  funcool/beicon      {:mvn/version "2021.07.05-1"}
   }
  :aliases
  {:outdated
@@ -14,7 +14,7 @@
 
   :dev
   {:extra-deps
-   {thheller/shadow-cljs {:mvn/version "2.14.1"}}}
+   {thheller/shadow-cljs {:mvn/version "2.15.2"}}}
 
   :shadow-cljs
   {:main-opts ["-m" "shadow.cljs.devtools.cli"]}

exporter/package.json

@@ -9,18 +9,18 @@
   "author": "UXBOX LABS SL",
   "license": "SEE LICENSE IN <LICENSE>",
   "dependencies": {
+    "generic-pool": "^3.8.2",
     "inflation": "^2.0.0",
-    "jszip": "^3.6.0",
+    "jszip": "^3.7.0",
     "koa": "^2.13.0",
-    "luxon": "^1.27.0",
-    "puppeteer": "^10.0.0",
-    "puppeteer-cluster": "^0.22.0",
+    "luxon": "^2.0.1",
+    "puppeteer-core": "^10.1.0",
     "raw-body": "^2.4.1",
     "xml-js": "^1.6.11",
     "xregexp": "^5.0.2"
   },
   "devDependencies": {
-    "shadow-cljs": "^2.14.2",
+    "shadow-cljs": "^2.15.2",
     "source-map-support": "^0.5.19"
   }
 }

exporter/src/app/browser.cljs

@@ -6,8 +6,10 @@
 
 (ns app.browser
   (:require
-   ["puppeteer-cluster" :as ppc]
+   ["puppeteer-core" :as pp]
+   ["generic-pool" :as gp]
    [app.common.data :as d]
+   [app.common.uuid :as uuid]
    [app.config :as cf]
    [lambdaisland.glogi :as log]
    [promesa.core :as p]))
@@ -20,12 +22,6 @@
   (str "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 "
        "(KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36"))
 
-(defn exec!
-  [browser f]
-  (.execute ^js browser (fn [props]
-                          (let [page (unchecked-get props "page")]
-                            (f page)))))
-
 (defn set-cookie!
   [page {:keys [key value domain]}]
   (.setCookie ^js page #js {:name key
@@ -73,12 +69,14 @@
 
 (defn pdf
   ([page] (pdf page nil))
-  ([page {:keys [viewport omit-background? prefer-css-page-size?]
+  ([page {:keys [viewport omit-background? prefer-css-page-size? save-path]
           :or {viewport {}
                omit-background? true
-               prefer-css-page-size? true}}]
+               prefer-css-page-size? true
+               save-path nil}}]
    (let [viewport (d/merge default-viewport viewport)]
-     (.pdf ^js page #js {:width (:width viewport)
+     (.pdf ^js page #js {:path save-path
+                         :width (:width viewport)
                          :height (:height viewport)
                          :scale (:scale viewport)
                          :omitBackground omit-background?
@@ -100,36 +98,76 @@
 
 ;; --- BROWSER STATE
 
-(def instance (atom nil))
+(defonce pool (atom nil))
+(defonce pool-browser-id (atom 1))
 
-(defn- create-browser
-  [concurrency strategy]
-  (let [strategy (case strategy
-                   :browser (.-CONCURRENCY_BROWSER ^js ppc/Cluster)
-                   :incognito (.-CONCURRENCY_CONTEXT ^js ppc/Cluster)
-                   :page (.-CONCURRENCY_PAGE ^js ppc/Cluster))
-        opts #js {:concurrency strategy
-                  :maxConcurrency concurrency
-                  :puppeteerOptions #js {:args #js ["--no-sandbox"]}}]
-    (.launch ^js ppc/Cluster opts)))
+(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"]})
+                  (p/then (fn [browser]
+                            (let [id (deref pool-browser-id)]
+                              (log/info :origin "factory" :action "create" :browser-id id)
+                              (unchecked-set browser "__num_use" 0)
+                              (unchecked-set browser "__id" id)
+                              (swap! pool-browser-id inc)
+                              browser))))))
+          (destroy [obj]
+            (let [id (unchecked-get obj "__id")]
+              (log/info :origin "factory" :action "destroy" :browser-id id)
+              (.close ^js obj)))
 
+          (validate [obj]
+            (let [max-use (cf/get :browser-max-usage 10)
+                  num-use (unchecked-get obj "__num_use")
+                  id      (unchecked-get obj "__id")]
+
+              (log/info :origin "factory" :action "validate" :browser-id id :max-use max-use :num-use num-use :obj obj)
+              (if (> num-use max-use)
+                (p/resolved false)
+                (do
+                  (unchecked-set obj "__num_use" (inc num-use))
+                  (p/resolved (.isConnected ^js obj))))))]
+
+    #js {:create create
+         :destroy destroy
+         :validate validate}))
 
 (defn init
   []
-  (let [concurrency (cf/get :browser-concurrency)
-        strategy    (cf/get :browser-strategy)]
-    (-> (create-browser concurrency strategy)
-        (p/then #(reset! instance %))
-        (p/catch (fn [error]
-                   (log/error :msg "failed to initialize browser")
-                   (js/console.error error))))))
+  (log/info :msg "initializing browser pool")
+  (let [opts #js {:max (cf/get :browser-pool-max 3)
+                  :min (cf/get :browser-pool-min 0)
+                  :testOnBorrow true
+                  :evictionRunIntervalMillis 30000
+                  :numTestsPerEvictionRun 5
+                  :acquireTimeoutMillis 120000 ; 2min
+                  :idleTimeoutMillis 30000}]
 
+    (reset! pool (gp/createPool browser-pool-factory opts))
+    (p/resolved nil)))
 
 (defn stop
   []
-  (if-let [instance @instance]
-    (p/do!
-     (.idle ^js instance)
-     (.close ^js instance)
-     (log/info :msg "shutdown headless browser"))
-    (p/resolved nil)))
+  (when-let [pool (deref pool)]
+    (log/info :msg "finalizing browser pool")
+    (-> (.drain ^js pool)
+        (p/then (fn [] (.clear ^js pool))))))
+
+(defn exec!
+  [f]
+  (letfn [(on-acquire [pool browser]
+            (p/let [ctx  (.createIncognitoBrowserContext ^js browser)
+                    page (.newPage ^js ctx)]
+              (-> (p/do! (f page))
+                  (p/handle
+                    (fn [result error]
+                      (-> (p/do! (.close ^js ctx)
+                                 (.release ^js pool browser))
+                          (p/handle (fn [_ _]
+                                      (if result
+                                        (p/resolved result)
+                                        (p/rejected error))))))))))]
+    (when-let [pool (deref pool)]
+      (-> (.acquire ^js pool)
+          (p/then (partial on-acquire pool))))))

exporter/src/app/config.cljs

@@ -7,13 +7,13 @@
 (ns app.config
   (:refer-clojure :exclude [get])
   (:require
-   [app.common.data :as d]
    ["process" :as process]
-   [cljs.pprint]
-   [cuerdas.core :as str]
+   [app.common.data :as d]
    [app.common.spec :as us]
-   [cljs.spec.alpha :as s]
    [cljs.core :as c]
+   [cljs.pprint]
+   [cljs.spec.alpha :as s]
+   [cuerdas.core :as str]
    [lambdaisland.uri :as u]))
 
 (def defaults
@@ -22,6 +22,7 @@
    :browser-concurrency 5
    :browser-strategy :incognito})
 
+(s/def ::browser-executable-path ::us/string)
 (s/def ::public-uri ::us/string)
 (s/def ::http-server-port ::us/integer)
 (s/def ::browser-concurrency ::us/integer)
@@ -31,7 +32,8 @@
   (s/keys :opt-un [::public-uri
                    ::http-server-port
                    ::browser-concurrency
-                   ::browser-strategy]))
+                   ::browser-strategy
+                   ::browser-executable-path]))
 (defn- read-env
   [prefix]
   (let [env    (unchecked-get process "env")

exporter/src/app/http.cljs

@@ -8,13 +8,15 @@
   (:require
    [app.config :as cf]
    [app.http.export :refer [export-handler]]
+   [app.http.export-frames :refer [export-frames-handler]]
    [app.http.impl :as impl]
    [lambdaisland.glogi :as log]
    [promesa.core :as p]
    [reitit.core :as r]))
 
 (def routes
-  [["/export" {:handler export-handler}]])
+  [["/export-frames" {:handler export-frames-handler}]
+   ["/export" {:handler export-handler}]])
 
 (def instance (atom nil))
 

exporter/src/app/http/export_frames.cljs

@@ -0,0 +1,69 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.http.export-frames
+  (:require
+   ["path" :as path]
+   [app.common.exceptions :as exc :include-macros true]
+   [app.common.spec :as us]
+   [app.renderer.pdf :as rp]
+   [app.util.shell :as sh]
+   [cljs.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [promesa.core :as p]))
+
+(s/def ::name ::us/string)
+(s/def ::file-id ::us/uuid)
+(s/def ::page-id ::us/uuid)
+(s/def ::frame-id ::us/uuid)
+(s/def ::frame-ids (s/coll-of ::frame-id :kind vector?))
+
+(s/def ::handler-params
+  (s/keys :req-un [::file-id ::page-id ::frame-ids]))
+
+(defn- export-frame
+  [tdpath file-id page-id token frame-id spaths]
+  (p/let [spath  (path/join tdpath (str frame-id ".pdf"))
+          result (rp/render {:name (str frame-id)
+                             :suffix ""
+                             :token token
+                             :file-id file-id
+                             :page-id page-id
+                             :object-id frame-id
+                             :scale 1
+                             :save-path spath})]
+    (cons spath spaths)))
+
+(defn- join-files
+  [tdpath file-id paths]
+  (let [output-path (path/join tdpath (str file-id ".pdf"))
+        paths-str   (str/join " " paths)]
+    (-> (sh/run-cmd! (str "gs -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -sOutputFile='" output-path "' " paths-str))
+        (p/then (constantly output-path)))))
+
+(defn- clean-tmp-data
+  [tdpath data]
+  (p/do!
+    (sh/rmdir! tdpath)
+    data))
+
+(defn export-frames-handler
+  [{:keys [params cookies] :as request}]
+  (let [{:keys [name file-id page-id frame-ids]} (us/conform ::handler-params params)
+        token  (.get ^js cookies "auth-token")]
+    (p/let [tdpath (sh/create-tmpdir! "pdfexport-")
+            data (-> (reduce (fn [promis frame-id]
+                               (p/then promis (partial export-frame tdpath file-id page-id token frame-id)))
+                       (p/future [])
+                       frame-ids)
+                     (p/then  (partial join-files tdpath file-id))
+                     (p/then  sh/read-file)
+                     (p/then  (partial clean-tmp-data tdpath)))]
+      {:status 200
+       :body data
+       :headers {"content-type" "application/pdf"
+                 "content-length" (.-length data)}})))
+

exporter/src/app/renderer/bitmap.cljs

@@ -29,7 +29,7 @@
      :value token}))
 
 (defn screenshot-object
-  [browser {:keys [file-id page-id object-id token scale type]}]
+  [{:keys [file-id page-id object-id token scale type]}]
   (letfn [(handle [page]
             (let [path   (str "/render-object/" file-id "/" page-id "/" object-id)
                   uri    (-> (u/uri (cf/get :public-uri))
@@ -55,7 +55,7 @@
                    :png  (bw/screenshot dom {:omit-background? true :type type})
                    :jpeg (bw/screenshot dom {:omit-background? false :type type}))))))]
 
-    (bw/exec! browser handle)))
+    (bw/exec! handle)))
 
 (s/def ::name ::us/string)
 (s/def ::suffix ::us/string)
@@ -74,22 +74,16 @@
 (defn render
   [params]
   (us/assert ::render-params params)
-  (let [browser @bw/instance]
-    (when-not browser
-      (ex/raise :type :internal
-                :code :browser-not-ready
-                :hint "browser cluster is not initialized yet"))
-
-    (p/let [content (screenshot-object browser params)]
-      {:content content
-       :filename (or (:filename params)
-                     (str (:name params)
-                          (:suffix params "")
-                          (case (:type params)
-                            :png ".png"
-                            :jpeg ".jpg")))
-       :length (alength content)
-       :mime-type (case (:type params)
-                    :png "image/png"
-                    :jpeg "image/jpeg")})))
+  (p/let [content (screenshot-object params)]
+    {:content content
+     :filename (or (:filename params)
+                   (str (:name params)
+                        (:suffix params "")
+                        (case (:type params)
+                          :png ".png"
+                          :jpeg ".jpg")))
+     :length (alength content)
+     :mime-type (case (:type params)
+                  :png "image/png"
+                  :jpeg "image/jpeg")}))
 

exporter/src/app/renderer/pdf.cljs

@@ -26,7 +26,7 @@
      :value token}))
 
 (defn pdf-from-object
-  [browser {:keys [file-id page-id object-id token scale type]}]
+  [{:keys [file-id page-id object-id token scale type save-path]}]
   (letfn [(handle [page]
             (let [path   (str "/render-object/" file-id "/" page-id "/" object-id)
                   uri    (-> (u/uri (cf/get :public-uri))
@@ -39,12 +39,14 @@
             (log/info :uri uri)
             (let [options {:cookie cookie}]
               (p/do!
-               (bw/configure-page! page options)
-               (bw/navigate! page uri)
-               (bw/wait-for page "#screenshot")
-               (bw/pdf page))))]
+                (bw/configure-page! page options)
+                (bw/navigate! page uri)
+                (bw/wait-for page "#screenshot")
+                (if save-path
+                  (bw/pdf page {:save-path save-path})
+                  (bw/pdf page)))))]
 
-    (bw/exec! browser handle)))
+    (bw/exec! handle)))
 
 (s/def ::name ::us/string)
 (s/def ::suffix ::us/string)
@@ -54,26 +56,21 @@
 (s/def ::scale ::us/number)
 (s/def ::token ::us/string)
 (s/def ::filename ::us/string)
+(s/def ::save-path ::us/string)
 
 (s/def ::render-params
   (s/keys :req-un [::name ::suffix ::object-id ::page-id ::scale ::token ::file-id]
-          :opt-un [::filename]))
+          :opt-un [::filename ::save-path]))
 
 (defn render
   [params]
   (us/assert ::render-params params)
-  (let [browser @bw/instance]
-    (when-not browser
-      (ex/raise :type :internal
-                :code :browser-not-ready
-                :hint "browser cluster is not initialized yet"))
-
-    (p/let [content (pdf-from-object browser params)]
-      {:content content
-       :filename (or (:filename params)
-                     (str (:name params)
-                          (:suffix params "")
-                          ".pdf"))
-       :length (alength content)
-       :mime-type "application/pdf"})))
+  (p/let [content (pdf-from-object params)]
+    {:content content
+     :filename (or (:filename params)
+                   (str (:name params)
+                        (:suffix params "")
+                        ".pdf"))
+     :length (alength content)
+     :mime-type "application/pdf"}))
 

exporter/src/app/renderer/svg.cljs

@@ -114,7 +114,7 @@
 
 
 (defn- render-object
-  [browser {:keys [page-id file-id object-id token scale suffix type]}]
+  [{:keys [page-id file-id object-id token scale suffix type]}]
   (letfn [(convert-to-ppm [pngpath]
             (log/trace :fn :convert-to-ppm)
             (let [basepath (path/dirname pngpath)
@@ -279,7 +279,7 @@
           rctx   {:cookie cookie
                   :uri (str uri)}]
       (log/info :uri (:uri rctx))
-      (bw/exec! browser (partial handle rctx)))))
+      (bw/exec! (partial handle rctx)))))
 
 (s/def ::name ::us/string)
 (s/def ::suffix ::us/string)
@@ -298,18 +298,11 @@
 (defn render
   [params]
   (us/assert ::render-params params)
-  (let [browser @bw/instance]
-    (when-not browser
-      (ex/raise :type :internal
-                :code :browser-not-ready
-                :hint "browser cluster is not initialized yet"))
-
-
-    (p/let [content (render-object browser params)]
-      {:content content
-       :filename (or (:filename params)
-                     (str (:name params)
-                          (:suffix params "")
-                          ".svg"))
-       :length (alength content)
-       :mime-type "image/svg+xml"})))
+  (p/let [content (render-object params)]
+    {:content content
+     :filename (or (:filename params)
+                   (str (:name params)
+                        (:suffix params "")
+                        ".svg"))
+     :length (alength content)
+     :mime-type "image/svg+xml"}))

exporter/yarn.lock

@@ -2,23 +2,23 @@
 # yarn lockfile v1
 
 
-"@babel/runtime-corejs3@^7.12.1":
-  version "7.14.0"
-  resolved "https://registry.yarnpkg.com/@babel/runtime-corejs3/-/runtime-corejs3-7.14.0.tgz#6bf5fbc0b961f8e3202888cb2cd0fb7a0a9a3f66"
-  integrity sha512-0R0HTZWHLk6G8jIk0FtoX+AatCtKnswS98VhXwGImFc759PJRp4Tru0PQYZofyijTFUr+gT8Mu7sgXVJLQ0ceg==
+"@babel/runtime-corejs3@^7.14.9":
+  version "7.15.3"
+  resolved "https://registry.yarnpkg.com/@babel/runtime-corejs3/-/runtime-corejs3-7.15.3.tgz#28754263988198f2a928c09733ade2fb4d28089d"
+  integrity sha512-30A3lP+sRL6ml8uhoJSs+8jwpKzbw8CqBvDc1laeptxPm5FahumJxirigcbD2qTs71Sonvj1cyZB0OKGAmxQ+A==
   dependencies:
-    core-js-pure "^3.0.0"
+    core-js-pure "^3.16.0"
     regenerator-runtime "^0.13.4"
 
 "@types/node@*":
-  version "15.6.2"
-  resolved "https://registry.yarnpkg.com/@types/node/-/node-15.6.2.tgz#c61d49f38af70da32424b5322eee21f97e627175"
-  integrity sha512-dxcOx8801kMo3KlU+C+/ctWrzREAH7YvoF3aoVpRdqgs+Kf7flp+PJDN/EX5bME3suDUZHsxes9hpvBmzYlWbA==
+  version "16.6.2"
+  resolved "https://registry.yarnpkg.com/@types/node/-/node-16.6.2.tgz#331b7b9f8621c638284787c5559423822fdffc50"
+  integrity sha512-LSw8TZt12ZudbpHc6EkIyDM3nHVWKYrAvGy6EAJfNfjusbwnThqjqxUKKRwuV3iWYeW/LYMzNgaq3MaLffQ2xA==
 
 "@types/yauzl@^2.9.1":
-  version "2.9.1"
-  resolved "https://registry.yarnpkg.com/@types/yauzl/-/yauzl-2.9.1.tgz#d10f69f9f522eef3cf98e30afb684a1e1ec923af"
-  integrity sha512-A1b8SU4D10uoPjwb0lnHmmu8wZhR9d+9o2PKBQT2jU5YPTKsxac6M2qGAdY7VcL+dHHhARVUDmeg0rOrcd9EjA==
+  version "2.9.2"
+  resolved "https://registry.yarnpkg.com/@types/yauzl/-/yauzl-2.9.2.tgz#c48e5d56aff1444409e39fa164b0b4d4552a7b7a"
+  integrity sha512-8uALY5LTvSuHgloDVUvWP3pIauILm+8/0pDMokuDYIoNsOkSwd5AiHBTSEJjKTDcZr5z8UpgOWZkxBF4iJftoA==
   dependencies:
     "@types/node" "*"
 
@@ -60,11 +60,6 @@ assert@^1.1.1:
     object-assign "^4.1.1"
     util "0.10.3"
 
-async-limiter@~1.0.0:
-  version "1.0.1"
-  resolved "https://registry.yarnpkg.com/async-limiter/-/async-limiter-1.0.1.tgz#dd379e94f0db8310b08291f9d64c3209766617fd"
-  integrity sha512-csOlWGAcRFJaI6m+F2WKdnMKr4HhdhFVBk0H/QbJFMCr+uO2kwohwXQPxw/9OCxp05r5ghVBFSyioixx3gfkNQ==
-
 balanced-match@^1.0.0:
   version "1.0.2"
   resolved "https://registry.yarnpkg.com/balanced-match/-/balanced-match-1.0.2.tgz#e83e3a7e3f300b34cb9d87f615fa0cbf357690ee"
@@ -174,9 +169,9 @@ buffer-crc32@~0.2.3:
   integrity sha1-DTM+PwDqxQqhRUq9MO+MKl2ackI=
 
 buffer-from@^1.0.0:
-  version "1.1.1"
-  resolved "https://registry.yarnpkg.com/buffer-from/-/buffer-from-1.1.1.tgz#32713bc028f75c02fdb710d7c7bcec1f2c6070ef"
-  integrity sha512-MQcXEUbCKtEo7bhqEs6560Hyd4XaovZlO/k9V3hjVUF/zwW7KBVdSK4gIt/bzwS9MbR5qob+F5jusZsb0YQK2A==
+  version "1.1.2"
+  resolved "https://registry.yarnpkg.com/buffer-from/-/buffer-from-1.1.2.tgz#2b146a6fd72e80b4f55d255f35ed59a3a9a41bd5"
+  integrity sha512-E+XQCRwSbaaiChtv6k6Dwgc+bx+Bs6vuKJHHl5kox/BaKbhiXzqQOwK4cO22yElGp2OCmjwVhT3HmxgyPGnJfQ==
 
 buffer-xor@^1.0.3:
   version "1.0.3"
@@ -271,10 +266,10 @@ cookies@~0.8.0:
     depd "~2.0.0"
     keygrip "~1.1.0"
 
-core-js-pure@^3.0.0:
-  version "3.13.1"
-  resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.13.1.tgz#5d139d346780f015f67225f45ee2362a6bed6ba1"
-  integrity sha512-wVlh0IAi2t1iOEh16y4u1TRk6ubd4KvLE8dlMi+3QUI6SfKphQUh7tAwihGGSQ8affxEXpVIPpOdf9kjR4v4Pw==
+core-js-pure@^3.16.0:
+  version "3.16.2"
+  resolved "https://registry.yarnpkg.com/core-js-pure/-/core-js-pure-3.16.2.tgz#0ef4b79cabafb251ea86eb7d139b42bd98c533e8"
+  integrity sha512-oxKe64UH049mJqrKkynWp6Vu0Rlm/BTXO/bJZuN2mmR3RtOFNepLlSWDd1eo16PzHpQAoNG97rLU1V/YxesJjw==
 
 core-util-is@~1.0.0:
   version "1.0.2"
@@ -329,7 +324,14 @@ crypto-browserify@^3.11.0:
     randombytes "^2.0.0"
     randomfill "^1.0.3"
 
-debug@4, debug@4.3.1, debug@^4.1.1:
+debug@4, debug@^4.1.1:
+  version "4.3.2"
+  resolved "https://registry.yarnpkg.com/debug/-/debug-4.3.2.tgz#f0a49c18ac8779e31d4a0c6029dfb76873c7428b"
+  integrity sha512-mOp8wKcvj7XxC78zLgw/ZA+6TSgkoE2C/ienthhRD298T7UNwAg9diBpLRxC0mOezLl4B0xV7M0cCO6P/O0Xhw==
+  dependencies:
+    ms "2.1.2"
+
+debug@4.3.1:
   version "4.3.1"
   resolved "https://registry.yarnpkg.com/debug/-/debug-4.3.1.tgz#f0d229c505e0c6d8c49ac553d1b13dc183f6b2ee"
   integrity sha512-doEwdvm4PCeK4K3RQN2ZC2BYUBaxwLARCqZmMjtF8a51J2Rb0xpVloFRnCODwqjpwnAoao4pelN8l3RJdv3gRQ==
@@ -376,10 +378,10 @@ destroy@^1.0.4:
   resolved "https://registry.yarnpkg.com/destroy/-/destroy-1.0.4.tgz#978857442c44749e4206613e37946205826abd80"
   integrity sha1-l4hXRCxEdJ5CBmE+N5RiBYJqvYA=
 
-devtools-protocol@0.0.883894:
-  version "0.0.883894"
-  resolved "https://registry.yarnpkg.com/devtools-protocol/-/devtools-protocol-0.0.883894.tgz#d403f2c75cd6d71c916aee8dde9258da988a4da9"
-  integrity sha512-33idhm54QJzf3Q7QofMgCvIVSd2o9H3kQPWaKT/fhoZh+digc+WSiMhbkeG3iN79WY4Hwr9G05NpbhEVrsOYAg==
+devtools-protocol@0.0.901419:
+  version "0.0.901419"
+  resolved "https://registry.yarnpkg.com/devtools-protocol/-/devtools-protocol-0.0.901419.tgz#79b5459c48fe7e1c5563c02bd72f8fec3e0cebcd"
+  integrity sha512-4INMPwNm9XRpBukhNbF7OB6fNTTCaI8pzy/fXg0xQzAy5h3zL1P8xT3QazgKqBrb/hAYwIBizqDBZ7GtJE74QQ==
 
 diffie-hellman@^5.0.0:
   version "5.0.3"
@@ -484,6 +486,11 @@ fs.realpath@^1.0.0:
   resolved "https://registry.yarnpkg.com/fs.realpath/-/fs.realpath-1.0.0.tgz#1504ad2523158caa40db4a2787cb01411994ea4f"
   integrity sha1-FQStJSMVjKpA20onh8sBQRmU6k8=
 
+generic-pool@^3.8.2:
+  version "3.8.2"
+  resolved "https://registry.yarnpkg.com/generic-pool/-/generic-pool-3.8.2.tgz#aab4f280adb522fdfbdc5e5b64d718d3683f04e9"
+  integrity sha512-nGToKy6p3PAbYQ7p1UlWl6vSPwfwU6TMSWK7TTu+WUY4ZjyZQGniGGt2oNVvyNSpyZYSB43zMXVLcBm08MTMkg==
+
 get-stream@^5.1.0:
   version "5.2.0"
   resolved "https://registry.yarnpkg.com/get-stream/-/get-stream-5.2.0.tgz#4966a1795ee5ace65e706c4b7beb71257d6e22d3"
@@ -503,6 +510,18 @@ glob@^7.1.3:
     once "^1.3.0"
     path-is-absolute "^1.0.0"
 
+has-symbols@^1.0.2:
+  version "1.0.2"
+  resolved "https://registry.yarnpkg.com/has-symbols/-/has-symbols-1.0.2.tgz#165d3070c00309752a1236a479331e3ac56f1423"
+  integrity sha512-chXa79rL/UC2KlX17jo3vRGz0azaWEx5tGqZg5pO3NUyEJVB17dMruQlzCCOfUvElghKcm5194+BCRvi2Rv/Gw==
+
+has-tostringtag@^1.0.0:
+  version "1.0.0"
+  resolved "https://registry.yarnpkg.com/has-tostringtag/-/has-tostringtag-1.0.0.tgz#7e133818a7d394734f941e73c3d3f9291e658b25"
+  integrity sha512-kFjcSNhnlGV1kyoGk7OXKSawH5JOb/LzUc5w9B02hOTO0dfFRjbHQKvg1d6cf3HbeUmtU9VbbV3qzZ2Teh97WQ==
+  dependencies:
+    has-symbols "^1.0.2"
+
 hash-base@^3.0.0:
   version "3.1.0"
   resolved "https://registry.yarnpkg.com/hash-base/-/hash-base-3.1.0.tgz#55c381d9e06e1d2997a883b4a3fddfe7f0d3af33"
@@ -618,9 +637,11 @@ inherits@2.0.3:
   integrity sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=
 
 is-generator-function@^1.0.7:
-  version "1.0.9"
-  resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.9.tgz#e5f82c2323673e7fcad3d12858c83c4039f6399c"
-  integrity sha512-ZJ34p1uvIfptHCN7sFTjGibB9/oBg17sHqzDLfuwhvmN/qLVvIQXRQ8licZQ35WJ8KuEQt/etnnzQFI9C9Ue/A==
+  version "1.0.10"
+  resolved "https://registry.yarnpkg.com/is-generator-function/-/is-generator-function-1.0.10.tgz#f1558baf1ac17e0deea7c0415c438351ff2b3c72"
+  integrity sha512-jsEjy9l3yiXEQ+PsXdmBwEPcOxaXWLspKdplFUVI9vq1iZgIekeC0L167qeu86czQaxed3q/Uzuw0swL0irL8A==
+  dependencies:
+    has-tostringtag "^1.0.0"
 
 isarray@^1.0.0, isarray@~1.0.0:
   version "1.0.0"
@@ -632,10 +653,10 @@ isexe@^2.0.0:
   resolved "https://registry.yarnpkg.com/isexe/-/isexe-2.0.0.tgz#e8fbf374dc556ff8947a10dcb0572d633f2cfa10"
   integrity sha1-6PvzdNxVb/iUehDcsFctYz8s+hA=
 
-jszip@^3.6.0:
-  version "3.6.0"
-  resolved "https://registry.yarnpkg.com/jszip/-/jszip-3.6.0.tgz#839b72812e3f97819cc13ac4134ffced95dd6af9"
-  integrity sha512-jgnQoG9LKnWO3mnVNBnfhkh0QknICd1FGSrXcgrl67zioyJ4wgx25o9ZqwNtrROSflGBCGYnJfjrIyRIby1OoQ==
+jszip@^3.7.0:
+  version "3.7.1"
+  resolved "https://registry.yarnpkg.com/jszip/-/jszip-3.7.1.tgz#bd63401221c15625a1228c556ca8a68da6fda3d9"
+  integrity sha512-ghL0tz1XG9ZEmRMcEN2vt7xabrDdqHHeykgARpmZ0BiIctWxM47Vt63ZO2dnp4QYt/xJVLLy5Zv1l/xRdh2byg==
   dependencies:
     lie "~3.3.0"
     pako "~1.0.2"
@@ -712,10 +733,10 @@ locate-path@^5.0.0:
   dependencies:
     p-locate "^4.1.0"
 
-luxon@^1.27.0:
-  version "1.27.0"
-  resolved "https://registry.yarnpkg.com/luxon/-/luxon-1.27.0.tgz#ae10c69113d85dab8f15f5e8390d0cbeddf4f00f"
-  integrity sha512-VKsFsPggTA0DvnxtJdiExAucKdAnwbCCNlMM5ENvHlxubqWd0xhZcdb4XgZ7QFNhaRhilXCFxHuoObP5BNA4PA==
+luxon@^2.0.1:
+  version "2.0.2"
+  resolved "https://registry.yarnpkg.com/luxon/-/luxon-2.0.2.tgz#11f2cd4a11655fdf92e076b5782d7ede5bcdd133"
+  integrity sha512-ZRioYLCgRHrtTORaZX1mx+jtxKtKuI5ZDvHNAmqpUzGqSrR+tL4FVLn/CUGMA3h0+AKD1MAxGI5GnCqR5txNqg==
 
 md5.js@^1.3.4:
   version "1.3.5"
@@ -739,17 +760,17 @@ miller-rabin@^4.0.0:
     bn.js "^4.0.0"
     brorand "^1.0.1"
 
-mime-db@1.48.0:
-  version "1.48.0"
-  resolved "https://registry.yarnpkg.com/mime-db/-/mime-db-1.48.0.tgz#e35b31045dd7eada3aaad537ed88a33afbef2d1d"
-  integrity sha512-FM3QwxV+TnZYQ2aRqhlKBMHxk10lTbMt3bBkMAp54ddrNeVSfcQYOOKuGuy3Ddrm38I04If834fOUSq1yzslJQ==
+mime-db@1.49.0:
+  version "1.49.0"
+  resolved "https://registry.yarnpkg.com/mime-db/-/mime-db-1.49.0.tgz#f3dfde60c99e9cf3bc9701d687778f537001cbed"
+  integrity sha512-CIc8j9URtOVApSFCQIF+VBkX1RwXp/oMMOrqdyXSBXq5RWNEsRfyj1kiRnQgmNXmHxPoFIxOroKA3zcU9P+nAA==
 
 mime-types@^2.1.18, mime-types@~2.1.24:
-  version "2.1.31"
-  resolved "https://registry.yarnpkg.com/mime-types/-/mime-types-2.1.31.tgz#a00d76b74317c61f9c2db2218b8e9f8e9c5c9e6b"
-  integrity sha512-XGZnNzm3QvgKxa8dpzyhFTHmpP3l5YNusmne07VUOXxou9CqUqYa/HBy124RqtVh/O2pECas/MOcsDgpilPOPg==
+  version "2.1.32"
+  resolved "https://registry.yarnpkg.com/mime-types/-/mime-types-2.1.32.tgz#1d00e89e7de7fe02008db61001d9e02852670fd5"
+  integrity sha512-hJGaVS4G4c9TSMYh2n6SQAGrC4RnfU+daP8G7cSCmaqNjiOoUY0VHCMS42pxnQmVF1GWwFhbHWn3RIxCqTmZ9A==
   dependencies:
-    mime-db "1.48.0"
+    mime-db "1.49.0"
 
 minimalistic-assert@^1.0.0, minimalistic-assert@^1.0.1:
   version "1.0.1"
@@ -986,20 +1007,13 @@ punycode@^1.2.4:
   resolved "https://registry.yarnpkg.com/punycode/-/punycode-1.4.1.tgz#c0d5a63b2718800ad8e1eb0fa5269c84dd41845e"
   integrity sha1-wNWmOycYgArY4esPpSachN1BhF4=
 
-puppeteer-cluster@^0.22.0:
-  version "0.22.0"
-  resolved "https://registry.yarnpkg.com/puppeteer-cluster/-/puppeteer-cluster-0.22.0.tgz#4ab214671f414f15ad6a94a4b61ed0b4172e86e6"
-  integrity sha512-hmydtMwfVM+idFIDzS8OXetnujHGre7RY3BGL+3njy9+r8Dcu3VALkZHfuBEPf6byKssTCgzxU1BvLczifXd5w==
-  dependencies:
-    debug "^4.1.1"
-
-puppeteer@^10.0.0:
-  version "10.0.0"
-  resolved "https://registry.yarnpkg.com/puppeteer/-/puppeteer-10.0.0.tgz#1b597c956103e2d989ca17f41ba4693b20a3640c"
-  integrity sha512-AxHvCb9IWmmP3gMW+epxdj92Gglii+6Z4sb+W+zc2hTTu10HF0yg6hGXot5O74uYkVqG3lfDRLfnRpi6WOwi5A==
+puppeteer-core@^10.1.0:
+  version "10.2.0"
+  resolved "https://registry.yarnpkg.com/puppeteer-core/-/puppeteer-core-10.2.0.tgz#8d6606cf345fc0e421bc0612055579ea53234111"
+  integrity sha512-c1COxSnfynsE6Mtt+dW0t3TITjF9Ku4dnJbFMDDVhLQuMTYSpz4rkSP37qvzcSo3k02/Ac3GYWk0/ncp6DKZNA==
   dependencies:
     debug "4.3.1"
-    devtools-protocol "0.0.883894"
+    devtools-protocol "0.0.901419"
     extract-zip "2.0.1"
     https-proxy-agent "5.0.0"
     node-fetch "2.6.1"
@@ -1074,9 +1088,9 @@ readline-sync@^1.4.7:
   integrity sha512-gNva8/6UAe8QYepIQH/jQ2qn91Qj0B9sYjMBBs3QOB8F2CXcKgLxQaJRP76sWVRQt+QU+8fAkCbCvjjMFu7Ycw==
 
 regenerator-runtime@^0.13.4:
-  version "0.13.7"
-  resolved "https://registry.yarnpkg.com/regenerator-runtime/-/regenerator-runtime-0.13.7.tgz#cac2dacc8a1ea675feaabaeb8ae833898ae46f55"
-  integrity sha512-a54FxoJDIr27pgf7IgeQGxmqUNYrcV338lf/6gH456HZ/PhX+5BcwHXG9ajESmwe6WRO0tAzRUrRmNONWgkrew==
+  version "0.13.9"
+  resolved "https://registry.yarnpkg.com/regenerator-runtime/-/regenerator-runtime-0.13.9.tgz#8925742a98ffd90814988d7566ad30ca3b263b52"
+  integrity sha512-p3VT+cOEgxFsRRA9X4lkI1E+k2/CtnKtU4gcxyaCUreilL/vqI6CdZ3wxVUx3UOUg+gnUOQQcRI7BmSI656MYA==
 
 rimraf@3.0.2:
   version "3.0.2"
@@ -1146,17 +1160,17 @@ shadow-cljs-jar@1.3.2:
   resolved "https://registry.yarnpkg.com/shadow-cljs-jar/-/shadow-cljs-jar-1.3.2.tgz#97273afe1747b6a2311917c1c88d9e243c81957b"
   integrity sha512-XmeffAZHv8z7451kzeq9oKh8fh278Ak+UIOGGrapyqrFBB773xN8vMQ3O7J7TYLnb9BUwcqadKkmgaq7q6fhZg==
 
-shadow-cljs@^2.14.2:
-  version "2.14.2"
-  resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.14.2.tgz#dba651ea124028064aea6fa9a390f257cb6eede4"
-  integrity sha512-ficaYfBAATzJ6OGt/GbIl393+cqLchzNkdTrM2PY4ttbsAOyBfWd39t+PZcYpCqemXjkgfBdZt9DJda7WaHJGA==
+shadow-cljs@^2.15.2:
+  version "2.15.4"
+  resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.15.4.tgz#0d657fc8ab9a02d8980db5c49cb1622e8fc6fa52"
+  integrity sha512-xn8UsiVpOf2LTsQZLsCa910CcMCYdMRT6STAsgveOEIncC9cunGdqE7cTq69vTmIijVQmzf0A1nALidyzO3Hcw==
   dependencies:
     node-libs-browser "^2.2.1"
     readline-sync "^1.4.7"
     shadow-cljs-jar "1.3.2"
     source-map-support "^0.4.15"
     which "^1.3.1"
-    ws "^3.0.0"
+    ws "^7.4.6"
 
 source-map-support@^0.4.15:
   version "0.4.18"
@@ -1282,11 +1296,6 @@ type-is@^1.6.16:
     media-typer "0.3.0"
     mime-types "~2.1.24"
 
-ultron@~1.1.0:
-  version "1.1.1"
-  resolved "https://registry.yarnpkg.com/ultron/-/ultron-1.1.1.tgz#9fe1536a10a664a65266a1e3ccf85fd36302bc9c"
-  integrity sha512-UIEXBNeYmKptWH6z8ZnqTeS8fV74zG0/eRU9VGkpzz+LIJNs8W/zM/L+7ctCkRrgbNnnR0xxw4bKOr0cW0N0Og==
-
 unbzip2-stream@1.3.3:
   version "1.3.3"
   resolved "https://registry.yarnpkg.com/unbzip2-stream/-/unbzip2-stream-1.3.3.tgz#d156d205e670d8d8c393e1c02ebd506422873f6a"
@@ -1354,14 +1363,10 @@ ws@7.4.6:
   resolved "https://registry.yarnpkg.com/ws/-/ws-7.4.6.tgz#5654ca8ecdeee47c33a9a4bf6d28e2be2980377c"
   integrity sha512-YmhHDO4MzaDLB+M9ym/mDA5z0naX8j7SIlT8f8z+I0VtzsRbekxEutHSme7NPS2qE8StCYQNUnfWdXta/Yu85A==
 
-ws@^3.0.0:
-  version "3.3.3"
-  resolved "https://registry.yarnpkg.com/ws/-/ws-3.3.3.tgz#f1cf84fe2d5e901ebce94efaece785f187a228f2"
-  integrity sha512-nnWLa/NwZSt4KQJu51MYlCcSQ5g7INpOrOMt4XV8j4dqTXdmlUmSHQ8/oLC069ckre0fRsgfvsKwbTdtKLCDkA==
-  dependencies:
-    async-limiter "~1.0.0"
-    safe-buffer "~5.1.0"
-    ultron "~1.1.0"
+ws@^7.4.6:
+  version "7.5.3"
+  resolved "https://registry.yarnpkg.com/ws/-/ws-7.5.3.tgz#160835b63c7d97bfab418fc1b8a9fced2ac01a74"
+  integrity sha512-kQ/dHIzuLrS6Je9+uv81ueZomEwH0qVYstcAQ4/Z93K8zeko9gtAbttJWzoC5ukqXY1PpoouV3+VSOqEAFt5wg==
 
 xml-js@^1.6.11:
   version "1.6.11"
@@ -1371,11 +1376,11 @@ xml-js@^1.6.11:
     sax "^1.2.4"
 
 xregexp@^5.0.2:
-  version "5.0.2"
-  resolved "https://registry.yarnpkg.com/xregexp/-/xregexp-5.0.2.tgz#798aa7757836f39cdbdeeba3daf94d75f7a9dcc1"
-  integrity sha512-JPNfN40YMNSDxZrahMrmtNH1QqPJp0/qNeEJM2nnOlhcBdfCCjekPYFV2OnwKxwvpEYglH1RBotbpRRaEuCG8Q==
+  version "5.1.0"
+  resolved "https://registry.yarnpkg.com/xregexp/-/xregexp-5.1.0.tgz#c87e7ae5ffa5fdc520f898a467dcba02b0d391e9"
+  integrity sha512-PynwUWtXnSZr8tpQlDPMZfPTyv78EYuA4oI959ukxcQ0a9O/lvndLVKy5wpImzzA26eMxpZmnAXJYiQA13AtWA==
   dependencies:
-    "@babel/runtime-corejs3" "^7.12.1"
+    "@babel/runtime-corejs3" "^7.14.9"
 
 xtend@^4.0.0:
   version "4.0.2"

frontend/deps.edn

@@ -8,7 +8,7 @@
 
   funcool/beicon {:mvn/version "2021.07.05-1"}
   funcool/okulary {:mvn/version "2020.04.14-0"}
-  funcool/potok {:mvn/version "2021.06.07-0"}
+  funcool/potok {:mvn/version "2021.09.20-0"}
   funcool/rumext {:mvn/version "2021.05.12-1"}
   funcool/tubax {:mvn/version "2021.05.20-0"}
 
@@ -23,7 +23,7 @@
 
   :dev
   {:extra-deps
-   {thheller/shadow-cljs {:mvn/version "2.15.1"}}}
+   {thheller/shadow-cljs {:mvn/version "2.15.2"}}}
 
   :shadow-cljs
   {:main-opts ["-m" "shadow.cljs.devtools.cli"]}

frontend/package.json

@@ -33,7 +33,7 @@
     "postcss-clean": "^1.2.2",
     "rimraf": "^3.0.0",
     "sass": "^1.35.1",
-    "shadow-cljs": "2.15.1"
+    "shadow-cljs": "2.15.2"
   },
   "dependencies": {
     "date-fns": "^2.22.1",

frontend/resources/images/cap-circle-marker.svg

@@ -0,0 +1 @@
+<svg width="16" height="6" xmlns="http://www.w3.org/2000/svg"><rect rx="6" ry="6" x="10" width="6" height="6"/><path d="M0 3h14.5" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-diamond-marker.svg

@@ -0,0 +1 @@
+<svg width="16" height="6" xmlns="http://www.w3.org/2000/svg"><rect rx="0" ry="0" x="11" y="1" transform="rotate(45 13 3)" width="4" height="4"/><path d="M0 3h14.5" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-line-arrow.svg

@@ -0,0 +1 @@
+<svg width="16" height="6" xmlns="http://www.w3.org/2000/svg"><path d="M0 3h14.5M11.7 0l1 1 1.6 2-2.6 3" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-round.svg

@@ -0,0 +1 @@
+<svg viewBox="1863 1374 16 8" width="16" height="8" xmlns="http://www.w3.org/2000/svg"><path d="M1879 1374h-12s-4 0-4 4 4 4 4 4h12" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-square-marker.svg

@@ -0,0 +1 @@
+<svg width="16" height="6" xmlns="http://www.w3.org/2000/svg"><rect rx="0" ry="0" x="10" width="6" height="6" fill="#070707"/><path d="M0 3h14.5" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-square.svg

@@ -0,0 +1 @@
+<svg viewBox="1863 1407 16 8" width="16" height="8" xmlns="http://www.w3.org/2000/svg"><path d="M1879 1407h-16v8h16" fill="none" stroke="#000"/></svg>

frontend/resources/images/cap-triangle-arrow.svg

@@ -0,0 +1 @@
+<svg width="16" height="6" xmlns="http://www.w3.org/2000/svg"><path d="M0 3h14.5" fill="none" stroke="#000"/><path d="M13 0l2.9 3L13 6V0z"/></svg>

frontend/resources/images/icons/switch.svg

@@ -0,0 +1,5 @@
+<svg viewBox="0 0 500 500" width="500" height="500" xmlns="http://www.w3.org/2000/svg">
+  <g>
+    <path d="M374.8 238.3l-19.6 18.5 94.8 97.3-437.2.3V383l437.2.3-94.8 97.3 18.8 19 126.4-130.8zM126 260.9l19.6-18.6L50.8 145H488v-28.8L50.8 116l94.8-97.2L126.8-.4.4 130.5z"/>
+  </g>
+</svg>

frontend/resources/styles/common/framework.scss

@@ -131,6 +131,24 @@
   }
 }
 
+.btn-text-dark {
+  @extend %btn;
+  background: $color-gray-60;
+  color: $color-gray-20;
+
+  svg {
+    fill: $color-gray-20;
+  }
+  &:hover {
+    background: $color-primary;
+    color: $color-gray-60;
+    svg {
+      fill: $color-gray-60;
+    }
+  }
+}
+
+
 .btn-gray {
   @extend %btn;
   background: $color-gray-30;
@@ -588,7 +606,6 @@ input.element-name {
       box-sizing: border-box;
       flex-shrink: 0;
     }
-
   }
 
   &.column {
@@ -975,6 +992,14 @@ input[type=range]:focus::-ms-fill-upper {
     }
   }
 
+  &.tooltip-expand {
+    &:hover {
+      &::after {
+        min-width: 100%;
+      }
+    }
+  }
+
   &.tooltip-bottom-left {
     &:hover {
       &::after {
@@ -1130,7 +1155,7 @@ input[type=range]:focus::-ms-fill-upper {
     padding-left: 16px;
     top: 16px;
     right: 16px;
-    z-index: 13;
+    z-index: 1005;
 
     display: flex;
     align-items: center;

frontend/resources/styles/main-default.scss

@@ -88,3 +88,4 @@
 @import "main/partials/color-bullet";
 @import "main/partials/handoff";
 @import "main/partials/exception-page";
+@import "main/partials/share-link";

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

@@ -38,6 +38,7 @@
       z-index: 12;
       max-height: 30rem;
       min-width: 230px;
+      overflow-y: auto;
     }
 
     .options-dropdown {

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

@@ -53,8 +53,8 @@
     .icon {
       display: flex;
       align-items: center;
-      width: 25px;
-      height: 25px;
+      width: 20px;
+      height: 20px;
       margin-right: 7px;
     }
   }

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

@@ -154,6 +154,10 @@
   .modal-footer .action-buttons {
     justify-content: space-around;
   }
+
+  .fields-container {
+    margin-top: 1rem;
+  }
 }
 
 .confirm-dialog {
@@ -807,7 +811,7 @@
         border-top-left-radius: 5px;
         border-bottom-left-radius: 5px;
         height: 100%;
-        width: 106%;
+        width: 115%;
       }
     }
   }

frontend/resources/styles/main/partials/share-link.scss

@@ -0,0 +1,141 @@
+.share-link-dialog {
+  width: 475px;
+  background-color: $color-white;
+
+  .modal-footer {
+    display: flex;
+    align-items: center;
+    justify-content: flex-end;
+    height: unset;
+    padding: 16px 26px;
+
+    .btn-primary,
+    .btn-secondary,
+    .btn-warning {
+      width: 126px;
+      margin-bottom: 0px;
+
+      &:not(:last-child) {
+        margin-right: 10px;
+      }
+    }
+
+    .confirm-dialog {
+      display: flex;
+      flex-direction: column;
+      background-color: unset;
+
+      .description {
+        font-size: $fs14;
+
+        margin-bottom: 16px;
+
+      }
+      .actions {
+        display: flex;
+        justify-content: flex-end;
+      }
+    }
+  }
+
+
+  .modal-content {
+    padding: 26px;
+
+    &:first-child {
+      border-top: 0px;
+    }
+
+    .title {
+      display: flex;
+      justify-content: space-between;
+
+      h2 {
+        font-size: $fs18;
+        color: $color-black;
+      }
+
+      .modal-close-button {
+        margin-right: 0px;
+      }
+    }
+
+
+    .share-link-section {
+      margin-top: 12px;
+      label {
+        font-size: $fs11;
+        color: $color-black;
+      }
+
+      .hint {
+        padding-top: 10px;
+        font-size: $fs14;
+        color: $color-gray-40;
+      }
+
+      .help-icon {
+        cursor: pointer;
+      }
+    }
+
+    .view-mode,
+    .access-mode {
+      display: flex;
+      flex-direction: column;
+
+      .title {
+        color: $color-black;
+        font-weight: 400;
+      }
+
+      .items {
+        padding-left: 20px;
+        display: flex;
+
+        > .input-checkbox, > .input-radio {
+          display: flex;
+          user-select: none;
+
+          /* input { */
+          /*   appearance: checkbox; */
+          /* } */
+
+          label {
+            display: flex;
+            align-items: center;
+            color: $color-black;
+
+            .hint {
+              margin-left: 5px;
+              color: $color-gray-30;
+            }
+          }
+
+          &.disabled {
+            label {
+              color: $color-gray-30;
+            }
+          }
+        }
+      }
+    }
+
+    .pages-selection {
+      padding-left: 20px;
+      max-height: 200px;
+      overflow-y: scroll;
+      user-select: none;
+
+      label {
+        color: $color-black;
+      }
+    }
+
+    .custom-input {
+      input {
+        padding: 0 40px 0 15px;
+      }
+    }
+  }
+}

frontend/resources/styles/main/partials/sidebar-element-options.scss

@@ -1316,7 +1316,7 @@
 
     &::after {
       content: ' ';
-      background-color: $color-gray-20;
+      background-color: $color-gray-30;
     }
 
     &.active,
@@ -1436,5 +1436,57 @@
       }
     }
   }
-
+}
+
+.cap-select {
+  background-color: transparent;
+  border: 1px solid transparent;
+  border-bottom-color: $color-gray-40;
+  color: $color-gray-10;
+  cursor: pointer;
+  font-size: $fs11;
+  margin: $x-small;
+  overflow: hidden;
+  padding: $x-small;
+  padding-right: 20px;
+  position: relative;
+  text-overflow: ellipsis;
+  white-space: nowrap;
+  width: 100%;
+
+  & .cap-select-button {
+    svg {
+      fill: $color-gray-10;
+      height: 11px;
+      position: absolute;
+      right: 5px;
+      top: 6px;
+      width: 11px;
+    }
+  }
+
+  &:hover {
+    border-color: $color-gray-40;
+  }
+
+  &:focus {
+    border-color: $color-primary;
+  }
+}
+
+.cap-select-dropdown {
+  right: 5px;
+  top: 30px;
+  z-index: 12;
+  min-width: 200px;
+  position: fixed;
+
+  & li.separator {
+    border-top: 1px solid $color-gray-10;
+  }
+
+  & li img {
+    width: 16px;
+    margin-right: $small;
+  }
 }

frontend/resources/styles/main/partials/viewer-header.scss

@@ -42,56 +42,64 @@
     }
   }
 
-  .view-options {
-    .icon {
-      align-items: center;
-      cursor: pointer;
-      display: flex;
-      justify-content: center;
+  .options-zone {
+    align-items: center;
+    display: flex;
+    // width: 384px;
+    justify-content: flex-end;
+    position: relative;
 
-      svg {
-        fill: $color-gray-30;
-        height: 30px;
-        width: 28px;
-      }
+    > * {
+      margin-left: $big;
+    }
 
-      &:hover {
-        > svg {
-          fill: $color-primary;
-        }
+    .btn-primary {
+      flex-shrink: 0;
+    }
+
+    .zoom-widget {
+      .dropdown {
+        top: 45px;
+        left: 25px;
       }
     }
 
-    .dropdown {
-      min-width: 260px;
-      left: 0px;
-      top: 40px;
-    }
-
-    .view-options-dropdown {
+    .view-options {
       align-items: center;
       cursor: pointer;
       display: flex;
+      width: 90px;
 
-      span {
+      > span {
         color: $color-gray-10;
         font-size: $fs13;
         margin-right: $x-small;
       }
 
-      svg {
-        fill: $color-gray-10;
-        height: 12px;
-        width: 12px;
-      }
-    }
-  }
+      > .icon {
+        align-items: center;
+        cursor: pointer;
+        display: flex;
+        justify-content: center;
 
-  .file-menu {
-    .dropdown {
-      min-width: 100px;
-      right: 0px;
-      top: 40px;
+        svg {
+          fill: $color-gray-10;
+          height: 12px;
+          width: 12px;
+        }
+
+        &:hover {
+          > svg {
+            fill: $color-primary;
+          }
+        }
+      }
+
+      .dropdown {
+        min-width: 260px;
+        top: 45px;
+        left: -25px;
+      }
     }
   }
 
@@ -100,39 +108,50 @@
     cursor: pointer;
     display: flex;
     padding: $x-small;
+    position: relative;
 
-    svg {
-      fill: $color-gray-20;
-      height: 20px;
-      margin-right: $small;
-      width: 20px;
-    }
+    .icon {
+      display: flex;
+      justify-content: center;
+      align-items: center;
 
-    span {
-      color: $color-gray-20;
-      margin-right: $x-small;
-      font-size: $fs14;
-      overflow-x: hidden;
-      text-overflow: ellipsis;
-      white-space: nowrap;
-
-      &.frame-name {
-        color: $color-white;
+      svg {
+        fill: $color-gray-20;
+        height: 12px;
+        margin-right: $small;
+        width: 12px;
       }
     }
 
-    .show-thumbnails-button svg {
-      fill: $color-white;
-      height: 10px;
-      width: 10px;
+    .breadcrumb, .current-frame {
+      display: flex;
+      position: relative;
+
+      > span {
+        color: $color-gray-20;
+        margin-right: $x-small;
+        font-size: $fs14;
+        overflow-x: hidden;
+        text-overflow: ellipsis;
+        white-space: nowrap;
+      }
+
+      > .dropdown {
+        top: 45px;
+        right: 10px;
+      }
     }
 
-    .page-name {
-      color: $color-white;
-    }
+    .current-frame {
+      display: flex;
+      span {
+        color: $color-white;
+        margin-right: $x-small;
+      }
 
-    .counters {
-      margin-left: $size-3;
+      .counters {
+        color: $color-gray-20;
+      }
     }
   }
 
@@ -166,133 +185,6 @@
     }
   }
 
-  .options-zone {
-    align-items: center;
-    display: flex;
-    width: 384px;
-    justify-content: flex-end;
-    position: relative;
-
-    > * {
-      margin-left: $big;
-    }
-
-    .btn-share {
-      display: flex;
-      align-items: center;
-      justify-content: center;
-      width: 25px;
-      height: 25px;
-      cursor: pointer;
-
-      svg {
-        fill: $color-gray-20;
-        width: 20px;
-        height: 20px;
-      }
-    }
-
-    .btn-primary {
-      flex-shrink: 0;
-    }
-  }
-
-  .share-link-dropdown {
-    background-color: $color-white;
-    border-radius: $br-small;
-    box-shadow: 0px 2px 8px rgba(0, 0, 0, 0.25);
-    display: flex;
-    flex-direction: column;
-    left: -135px;
-    position: absolute;
-    padding: 1rem;
-    top: 45px;
-    width: 400px;
-
-    .share-link-title {
-      color: $color-black;
-      font-size: $fs15;
-      padding-bottom: 1rem;
-    }
-
-    .share-link-subtitle {
-      color: $color-gray-40;
-      padding-bottom: 1rem;
-    }
-
-    .share-link-buttons {
-      display: flex;
-      justify-content: center;
-      align-items: center;
-
-      .btn-warning,
-      .btn-primary {
-        width: 50%;
-      }
-
-    }
-
-    .share-link-input {
-      border: 1px solid $color-gray-20;
-      border-radius: 3px;
-      display: flex;
-      height: 40px;
-      justify-content: space-between;
-      margin-bottom: 1rem;
-      padding: 9px $small;
-      overflow: hidden;
-
-      .link {
-        &:before {
-          content: '';
-          position: absolute;
-          width: 50%;
-          background: linear-gradient(45deg, transparent, #ffffff);
-          height: 100%;
-          top: 0;
-          left: 0;
-          pointer-events: none;
-          margin-left: 50%;
-        }
-        overflow: hidden;
-        white-space: nowrap;
-        position: relative;
-        color: $color-gray-50;
-        line-height: 1.5;
-        user-select: all;
-        overflow: hidden;
-      }
-
-      .link-button {
-        color: $color-primary-dark;
-        cursor: pointer;
-        flex-shrink: 0;
-        font-size: $fs15;
-
-        &:hover {
-          color: $color-black;
-        }
-      }
-    }
-
-    &:before {
-      background-color: $color-white;
-      content: "";
-      height: 16px;
-      left: 53%;
-      position: absolute;
-      transform: rotate(45deg);
-      top: -5px;
-      width: 16px;
-    }
-
-  }
-
-  .zoom-dropdown {
-    left: 180px;
-    top: 40px;
-  }
-
   .users-zone {
     align-items: center;
     cursor: pointer;

frontend/resources/styles/main/partials/viewer-thumbnails.scss

@@ -1,4 +1,3 @@
-
 .viewer-thumbnails {
   grid-row: 1 / span 1;
   grid-column:  1 / span 1;
@@ -9,6 +8,11 @@
   flex-direction: column;
   z-index: 12;
 
+  &.invisible {
+    visibility: hidden;
+    pointer-events: none;
+  }
+
   &.expanded {
     grid-row: 1 / span 2;
 
@@ -159,7 +163,7 @@
 
     &:hover {
       border-color: $color-primary;
-      border-width: 2px;
+      outline: 2px solid $color-primary;
     }
   }
 

frontend/resources/styles/main/partials/zoom-widget.scss

@@ -8,13 +8,13 @@
     margin-left: $x-small;
   }
 
-  .dropdown-button svg {
+  .icon svg {
     fill: $color-gray-10;
     height: 10px;
     width: 10px;
   }
 
-  .zoom-dropdown {
+  .dropdown {
     position: absolute;
     z-index: 12;
     width: 210px;

frontend/src/app/config.cljs

@@ -6,6 +6,7 @@
 
 (ns app.config
   (:require
+   [app.common.flags :as flags]
    [app.common.spec :as us]
    [app.common.uri :as u]
    [app.common.version :as v]
@@ -53,10 +54,22 @@
     :browser
     :webworker))
 
+(def available-flags
+  #{:registration
+    :audit-log
+    :demo-users
+    :user-feedback
+    :demo-warning
+    :login-with-ldap})
+
+(def default-flags
+  #{:registration :demo-users})
+
 (defn- parse-flags
   [global]
-  (let [flags (obj/get global "penpotFlags" "")]
-    (into #{} (map keyword) (str/words flags))))
+  (let [flags (obj/get global "penpotFlags" "")
+        flags (into #{} (map keyword) (str/words flags))]
+    (flags/parse default-flags flags)))
 
 (defn- parse-version
   [global]
@@ -68,26 +81,27 @@
 (def default-theme  "default")
 (def default-language "en")
 
-(def demo-warning         (obj/get global "penpotDemoWarning" false))
-(def feedback-enabled     (obj/get global "penpotFeedbackEnabled" false))
-(def allow-demo-users     (obj/get global "penpotAllowDemoUsers" true))
 (def google-client-id     (obj/get global "penpotGoogleClientID" nil))
 (def gitlab-client-id     (obj/get global "penpotGitlabClientID" nil))
 (def github-client-id     (obj/get global "penpotGithubClientID" nil))
 (def oidc-client-id       (obj/get global "penpotOIDCClientID" nil))
-(def login-with-ldap      (obj/get global "penpotLoginWithLDAP" false))
-(def registration-enabled (obj/get global "penpotRegistrationEnabled" true))
 (def worker-uri           (obj/get global "penpotWorkerURI" "/js/worker.js"))
 (def translations         (obj/get global "penpotTranslations"))
 (def themes               (obj/get global "penpotThemes"))
-(def analytics            (obj/get global "penpotAnalyticsEnabled" false))
 
-(def flags                (delay (parse-flags global)))
+(def flags                (atom (parse-flags global)))
+(def version              (atom (parse-version global)))
+(def target               (atom (parse-target global)))
+(def browser              (atom (parse-browser)))
+(def platform             (atom (parse-platform)))
 
-(def version              (delay (parse-version global)))
-(def target               (delay (parse-target global)))
-(def browser              (delay (parse-browser)))
-(def platform             (delay (parse-platform)))
+;; mantain for backward compatibility
+(let [login-with-ldap (obj/get global "penpotLoginWithLDAP" false)
+      registration    (obj/get global "penpotRegistrationEnabled" true)]
+  (when login-with-ldap
+    (swap! flags conj :login-with-ldap))
+  (when (false? registration)
+    (swap! flags disj :registration)))
 
 (def public-uri
   (let [uri (u/uri (or (obj/get global "penpotPublicURI")

frontend/src/app/main.cljs

@@ -42,10 +42,13 @@
     (if-let [conform (get-in match [:data :conform])]
       (let [spath  (get conform :path-params ::any)
             squery (get conform :query-params ::any)]
-        (-> (dissoc match :params)
-            (assoc :path-params (us/conform spath (get match :path-params))
-                   :query-params (us/conform squery (get match :query-params)))))
-      match)))
+        (try
+          (-> (dissoc match :params)
+              (assoc :path-params (us/conform spath (get match :path-params))
+                     :query-params (us/conform squery (get match :query-params))))
+          (catch :default _
+            nil)))
+        match)))
 
 (defn on-navigate
   [router path]

frontend/src/app/main/data/comments.cljs

@@ -72,7 +72,7 @@
                 (update :workspace-drawing dissoc :comment)
                 (update-in [:comments id] assoc (:id comment) comment)))]
 
-    (ptk/reify ::create-thread
+    (ptk/reify ::create-comment-thread
       ptk/WatchEvent
       (watch [_ _ _]
         (->> (rp/mutation :create-comment-thread params)
@@ -94,6 +94,8 @@
   [{:keys [id is-resolved] :as thread}]
   (us/assert ::comment-thread thread)
   (ptk/reify ::update-comment-thread
+    IDeref
+    (-deref [_] {:is-resolved is-resolved})
 
     ptk/UpdateEvent
     (update [_ state]
@@ -122,7 +124,7 @@
 (defn update-comment
   [{:keys [id content thread-id] :as comment}]
   (us/assert ::comment comment)
-  (ptk/reify :update-comment
+  (ptk/reify ::update-comment
     ptk/UpdateEvent
     (update [_ state]
       (d/update-in-when state [:comments thread-id id] assoc :content content))
@@ -135,7 +137,7 @@
 (defn delete-comment-thread
   [{:keys [id] :as thread}]
   (us/assert ::comment-thread thread)
-  (ptk/reify :delete-comment-thread
+  (ptk/reify ::delete-comment-thread
     ptk/UpdateEvent
     (update [_ state]
       (-> state
@@ -150,7 +152,7 @@
 (defn delete-comment
   [{:keys [id thread-id] :as comment}]
   (us/assert ::comment comment)
-  (ptk/reify :delete-comment
+  (ptk/reify ::delete-comment
     ptk/UpdateEvent
     (update [_ state]
       (d/update-in-when state [:comments thread-id] dissoc id))
@@ -212,7 +214,7 @@
 (defn open-thread
   [{:keys [id] :as thread}]
   (us/assert ::comment-thread thread)
-  (ptk/reify ::open-thread
+  (ptk/reify ::open-comment-thread
     ptk/UpdateEvent
     (update [_ state]
       (-> state
@@ -221,7 +223,7 @@
 
 (defn close-thread
   []
-  (ptk/reify ::close-thread
+  (ptk/reify ::close-comment-thread
     ptk/UpdateEvent
     (update [_ state]
       (-> state

frontend/src/app/main/data/common.cljs

@@ -0,0 +1,46 @@
+;; 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.main.data.common
+  "A general purpose events."
+  (:require
+   [app.main.repo :as rp]
+   [beicon.core :as rx]
+   [potok.core :as ptk]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SHARE LINK
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn share-link-created
+  [link]
+  (ptk/reify ::share-link-created
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :share-links (fnil conj []) link))))
+
+(defn create-share-link
+  [params]
+  (ptk/reify ::create-share-link
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (->> (rp/mutation! :create-share-link params)
+           (rx/map share-link-created)))))
+
+(defn delete-share-link
+  [{:keys [id] :as link}]
+  (ptk/reify ::delete-share-link
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :share-links
+              (fn [links]
+                (filterv #(not= id (:id %)) links))))
+
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (->> (rp/mutation! :delete-share-link {:id id})
+           (rx/ignore)))))
+

frontend/src/app/main/data/dashboard.cljs

@@ -9,6 +9,7 @@
    [app.common.data :as d]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.main.data.events :as ev]
    [app.main.data.fonts :as df]
    [app.main.data.media :as di]
    [app.main.data.users :as du]
@@ -386,6 +387,9 @@
   (us/assert ::us/email email)
   (us/assert ::us/keyword role)
   (ptk/reify ::invite-team-member
+    IDeref
+    (-deref [_] {:role role})
+
     ptk/WatchEvent
     (watch [_ state _]
       (let [{:keys [on-success on-error]
@@ -475,6 +479,10 @@
   (us/assert ::us/uuid id)
   (us/assert ::us/uuid team-id)
   (ptk/reify ::move-project
+    IDeref
+    (-deref [_]
+      {:id id :team-id team-id})
+
     ptk/WatchEvent
     (watch [_ _ _]
       (let [{:keys [on-success on-error]
@@ -566,6 +574,10 @@
   [{:keys [id name] :as params}]
   (us/assert ::file params)
   (ptk/reify ::rename-file
+    IDeref
+    (-deref [_]
+      {::ev/origin "dashboard" :id id :name name})
+
     ptk/UpdateEvent
     (update [_ state]
       (-> state
@@ -585,6 +597,10 @@
   [{:keys [id is-shared] :as params}]
   (us/assert ::file params)
   (ptk/reify ::set-file-shared
+    IDeref
+    (-deref [_]
+      {::ev/origin "dashboard" :id id :shared is-shared})
+
     ptk/UpdateEvent
     (update [_ state]
       (-> state
@@ -663,12 +679,16 @@
   (us/assert ::set-of-uuid ids)
   (us/assert ::us/uuid project-id)
   (ptk/reify ::move-files
+    IDeref
+    (-deref [_]
+      {:num-files (count ids)
+       :project-id project-id})
+
     ptk/WatchEvent
     (watch [_ _ _]
       (let [{:keys [on-success on-error]
              :or {on-success identity
                   on-error rx/throw}} (meta params)]
-
         (->> (rp/mutation! :move-files {:ids ids :project-id project-id})
              (rx/tap on-success)
              (rx/catch on-error))))))
@@ -690,14 +710,14 @@
 
 (defn go-to-files
   ([project-id]
-   (ptk/reify ::go-to-files
+   (ptk/reify ::go-to-files-1
      ptk/WatchEvent
      (watch [_ state _]
        (let [team-id (:current-team-id state)]
          (rx/of (rt/nav :dashboard-files {:team-id team-id
                                           :project-id project-id}))))))
   ([team-id project-id]
-   (ptk/reify ::go-to-files
+   (ptk/reify ::go-to-files-2
      ptk/WatchEvent
      (watch [_ _ _]
        (rx/of (rt/nav :dashboard-files {:team-id team-id
@@ -719,13 +739,13 @@
 
 (defn go-to-projects
   ([]
-   (ptk/reify ::go-to-projects
+   (ptk/reify ::go-to-projects-0
      ptk/WatchEvent
      (watch [_ state _]
        (let [team-id (:current-team-id state)]
          (rx/of (rt/nav :dashboard-projects {:team-id team-id}))))))
   ([team-id]
-   (ptk/reify ::go-to-projects
+   (ptk/reify ::go-to-projects-1
      ptk/WatchEvent
      (watch [_ _ _]
        (du/set-current-team! team-id)

frontend/src/app/main/data/events.cljs

@@ -71,18 +71,84 @@
 
 ;; --- EVENT TRANSLATION
 
-(defmulti ^:private process-event ptk/type)
+(derive :app.main.data.comments/create-comment ::generic-action)
+(derive :app.main.data.comments/create-comment-thread ::generic-action)
+(derive :app.main.data.comments/delete-comment ::generic-action)
+(derive :app.main.data.comments/delete-comment-thread ::generic-action)
+(derive :app.main.data.comments/open-comment-thread ::generic-action)
+(derive :app.main.data.comments/update-comment ::generic-action)
+(derive :app.main.data.comments/update-comment-thread ::generic-action)
+(derive :app.main.data.comments/update-comment-thread-status ::generic-action)
+(derive :app.main.data.dashboard/delete-team-member ::generic-action)
+(derive :app.main.data.dashboard/duplicate-project ::generic-action)
+(derive :app.main.data.dashboard/file-created ::generic-action)
+(derive :app.main.data.dashboard/invite-team-member ::generic-action)
+(derive :app.main.data.dashboard/leave-team ::generic-action)
+(derive :app.main.data.dashboard/move-files ::generic-action)
+(derive :app.main.data.dashboard/move-project ::generic-action)
+(derive :app.main.data.dashboard/project-created ::generic-action)
+(derive :app.main.data.dashboard/rename-file ::generic-action)
+(derive :app.main.data.dashboard/set-file-shared ::generic-action)
+(derive :app.main.data.dashboard/update-team-member-role ::generic-action)
+(derive :app.main.data.dashboard/update-team-photo ::generic-action)
+(derive :app.main.data.fonts/add-font ::generic-action)
+(derive :app.main.data.fonts/delete-font ::generic-action)
+(derive :app.main.data.fonts/delete-font-variant ::generic-action)
+(derive :app.main.data.users/logout ::generic-action)
+(derive :app.main.data.users/request-email-change ::generic-action)
+(derive :app.main.data.users/update-password ::generic-action)
+(derive :app.main.data.users/update-photo ::generic-action)
+(derive :app.main.data.workspace.comments/open-comment-thread ::generic-action)
+(derive :app.main.data.workspace.libraries/add-color ::generic-action)
+(derive :app.main.data.workspace.libraries/add-media ::generic-action)
+(derive :app.main.data.workspace.libraries/add-typography ::generic-action)
+(derive :app.main.data.workspace.libraries/delete-color ::generic-action)
+(derive :app.main.data.workspace.libraries/delete-media ::generic-action)
+(derive :app.main.data.workspace.libraries/delete-typography ::generic-action)
+(derive :app.main.data.workspace.persistence/attach-library ::generic-action)
+(derive :app.main.data.workspace.persistence/detach-library ::generic-action)
+(derive :app.main.data.workspace.persistence/set-file-shard ::generic-action)
+(derive :app.main.data.workspace/create-page ::generic-action)
+(derive :app.main.data.workspace/set-workspace-layout ::generic-action)
+
+
+(defmulti process-event ptk/type)
 (defmethod process-event :default [_] nil)
 
 (defmethod process-event ::event
   [event]
-  (let [data (deref event)]
+  (let [data   (deref event)
+        origin (::origin data)]
     (when (::name data)
       (d/without-nils
        {:type    (::type data "action")
         :name    (::name data)
         :context (::context data)
-        :props   (dissoc data ::name ::type ::context)}))))
+        :props   (-> data
+                     (dissoc ::name)
+                     (dissoc ::type)
+                     (dissoc ::origin)
+                     (dissoc ::context)
+                     (cond-> origin (assoc :origin origin)))}))))
+
+(defmethod process-event ::generic-action
+  [event]
+  (let [type  (ptk/type event)
+        mdata (meta event)
+        data  (if (satisfies? IDeref event)
+                (deref event)
+                {})
+
+        name  (or (::name mdata)
+                  (name type))]
+
+    {:type    "action"
+     :name    (name type)
+     :props   (merge data (d/without-nils (::props mdata)))
+     :context (d/without-nils
+               {:event-origin (::origin mdata)
+                :event-namespace (namespace type)
+                :event-symbol (name type)})}))
 
 (defmethod process-event :app.util.router/navigated
   [event]
@@ -113,42 +179,6 @@
      :profile-id (:id data)
      :props (d/without-nils props)}))
 
-(defmethod process-event :app.main.data.dashboard/project-created
-  [event]
-  (let [data (deref event)]
-    {:type "action"
-     :name "create-project"
-     :props {:id (:id data)
-             :team-id (:team-id data)}}))
-
-(defmethod process-event :app.main.data.dashboard/file-created
-  [event]
-  (let [data (deref event)]
-    {:type "action"
-     :name "create-file"
-     :props {:id (:id data)
-             :project-id (:project-id data)}}))
-
-(defmethod process-event :app.main.data.workspace/create-page
-  [event]
-  (let [data (deref event)]
-    {:type "action"
-     :name "create-page"
-     :props {:id (:id data)
-             :file-id (:file-id data)
-             :project-id (:project-id data)}}))
-
-(defn- event->generic-action
-  [_ name]
-  {:type "action"
-   :name name
-   :props {}})
-
-(defmethod process-event :app.main.data.users/logout
-  [event]
-  (event->generic-action event "signout"))
-
-
 ;; --- MAIN LOOP
 
 (defn- append-to-buffer
@@ -164,7 +194,7 @@
 (defn- persist-events
   [events]
   (if (seq events)
-    (let [uri    (u/join cf/public-uri "events")
+    (let [uri    (u/join cf/public-uri "api/audit/events")
           params {:events events}]
       (->> (http/send! {:uri uri
                         :method :post
@@ -203,8 +233,7 @@
 
       ptk/EffectEvent
       (effect [_ _ stream]
-        (let [events  (methods process-event)
-              session (atom nil)
+        (let [session (atom nil)
 
               profile (->> (rx/from-atom storage {:emit-current-value? true})
                            (rx/map :profile)
@@ -215,12 +244,9 @@
                            (rx/with-latest-from profile)
                            (rx/map (fn [result]
                                      (let [event      (aget result 0)
-                                           profile-id (aget result 1)
-                                           type       (ptk/type event)
-                                           impl-fn    (get events type)]
-                                       (when (fn? impl-fn)
-                                         (some-> (impl-fn event)
-                                                 (update :profile-id #(or % profile-id)))))))
+                                           profile-id (aget result 1)]
+                                       (some-> (process-event event)
+                                               (update :profile-id #(or % profile-id))))))
                            (rx/filter :profile-id)
                            (rx/map (fn [event]
                                      (let [session* (or @session (dt/now))
@@ -242,6 +268,6 @@
 
 (defmethod ptk/resolve ::initialize
   [_ params]
-  (if cf/analytics
+  (if (contains? @cf/flags :audit-log)
     (initialize)
     (ptk/data-event ::initialize params)))

frontend/src/app/main/data/fonts.cljs

@@ -111,10 +111,13 @@
                                            (:data content)})
                              (dissoc :content)))))))
 
-          (parse-mtype [mtype]
-            (case mtype
-              "application/vnd.oasis.opendocument.formula-template" "font/otf"
-              mtype))
+          (parse-mtype [ba]
+            (let [u8 (js/Uint8Array. ba 0 4)
+                  sg (areduce u8 i ret "" (str ret (if (zero? i) "" " ") (.toString (aget u8 i) 8)))]
+              (case sg
+                "117 124 124 117" "font/otf"
+                "0 1 0 0"         "font/ttf"
+                "167 117 106 106" "font/woff")))
 
           (parse-font [{:keys [data] :as params}]
             (try
@@ -128,7 +131,11 @@
                  (rx/map (fn [data]
                            {:data data
                             :name (.-name blob)
-                            :type (parse-mtype (.-type blob))}))))]
+                            :type (parse-mtype data)}))
+                 (rx/mapcat (fn [{:keys [type] :as font}]
+                              (if type
+                                (rx/of font)
+                                (rx/empty))))))]
 
     (->> (rx/from blobs)
          (rx/mapcat read-blob)
@@ -180,6 +187,9 @@
 (defn add-font
   [font]
   (ptk/reify ::add-font
+    IDeref
+    (-deref [_] (select-keys font [:font-family :font-style :font-weight]))
+
     ptk/UpdateEvent
     (update [_ state]
       (update state :dashboard-fonts assoc (:id font) font))))

frontend/src/app/main/data/messages.cljs

@@ -52,11 +52,17 @@
 
     ptk/WatchEvent
     (watch [_ _ stream]
-      (when (:timeout data)
-        (let [stoper (rx/filter (ptk/type? ::show) stream)]
-          (->> (rx/of hide)
-               (rx/delay (:timeout data))
-               (rx/take-until stoper)))))))
+      (rx/merge
+        (let [stoper (rx/filter (ptk/type? ::hide) stream)]
+          (->> stream
+               (rx/filter (ptk/type? :app.util.router/navigate))
+               (rx/map (constantly hide))
+               (rx/take-until stoper)))
+        (when (:timeout data)
+          (let [stoper (rx/filter (ptk/type? ::show) stream)]
+            (->> (rx/of hide)
+                 (rx/delay (:timeout data))
+                 (rx/take-until stoper))))))))
 
 (def hide
   (ptk/reify ::hide

frontend/src/app/main/data/users.cljs

@@ -24,6 +24,10 @@
 
 ;; --- COMMON SPECS
 
+(defn is-authenticated?
+  [{:keys [id]}]
+  (and (uuid? id) (not= id uuid/zero)))
+
 (s/def ::id ::us/uuid)
 (s/def ::fullname ::us/string)
 (s/def ::email ::us/email)

frontend/src/app/main/data/viewer.cljs

@@ -14,24 +14,12 @@
    [app.main.data.comments :as dcm]
    [app.main.data.fonts :as df]
    [app.main.repo :as rp]
+   [app.util.globals :as ug]
    [app.util.router :as rt]
    [beicon.core :as rx]
    [cljs.spec.alpha :as s]
    [potok.core :as ptk]))
 
-;; --- General Specs
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-
-(s/def ::project (s/keys :req-un [::id ::name]))
-(s/def ::file (s/keys :req-un [::id ::name]))
-(s/def ::page ::cp/page)
-
-(s/def ::bundle
-  (s/keys :req-un [::project ::file ::page]))
-
-
 ;; --- Local State Initialization
 
 (def ^:private
@@ -49,25 +37,24 @@
 (declare fetch-bundle)
 (declare bundle-fetched)
 
-(s/def ::page-id ::us/uuid)
 (s/def ::file-id ::us/uuid)
 (s/def ::index ::us/integer)
-(s/def ::token (s/nilable ::us/string))
+(s/def ::page-id (s/nilable ::us/uuid))
+(s/def ::share-id (s/nilable ::us/uuid))
 (s/def ::section ::us/string)
 
 (s/def ::initialize-params
-  (s/keys :req-un [::page-id ::file-id]
-          :opt-un [::token]))
+  (s/keys :req-un [::file-id]
+          :opt-un [::share-id ::page-id]))
 
 (defn initialize
-  [{:keys [page-id file-id] :as params}]
+  [{:keys [file-id] :as params}]
   (us/assert ::initialize-params params)
   (ptk/reify ::initialize
     ptk/UpdateEvent
     (update [_ state]
       (-> state
           (assoc :current-file-id file-id)
-          (assoc :current-page-id page-id)
           (update :viewer-local
                   (fn [lstate]
                     (if (nil? lstate)
@@ -77,55 +64,72 @@
     ptk/WatchEvent
     (watch [_ _ _]
       (rx/of (fetch-bundle params)
-             (fetch-comment-threads params)))))
+             (fetch-comment-threads params)))
 
-;; --- Data Fetching
+    ptk/EffectEvent
+    (effect [_ _ _]
+      ;; Set the window name, the window name is used on inter-tab
+      ;; navigation; in other words: when a user opens a tab with a
+      ;; name, if there are already opened tab with that name, the
+      ;; browser just focus the opened tab instead of creating new
+      ;; tab.
+      (let [name (str "viewer-" file-id)]
+        (unchecked-set ug/global "name" name)))))
 
-(s/def ::fetch-bundle-params
-  (s/keys :req-un [::page-id ::file-id]
-          :opt-un [::token]))
+(defn finalize
+  [_]
+  (ptk/reify ::finalize
+    ptk/UpdateEvent
+    (update [_ state]
+      (dissoc state :viewer))))
 
-(defn fetch-bundle
-  [{:keys [page-id file-id token] :as params}]
-  (us/assert ::fetch-bundle-params params)
-  (ptk/reify ::fetch-file
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [params (cond-> {:page-id page-id
-                            :file-id file-id}
-                     (string? token) (assoc :token token))]
-        (->> (rp/query :viewer-bundle params)
-             (rx/mapcat
-              (fn [{:keys [fonts] :as bundle}]
-                (rx/of (df/fonts-fetched fonts)
-                       (bundle-fetched bundle)))))))))
-
-(defn- extract-frames
-  [objects]
+(defn select-frames
+  [{:keys [objects] :as page}]
   (let [root (get objects uuid/zero)]
     (into [] (comp (map #(get objects %))
                    (filter #(= :frame (:type %))))
           (reverse (:shapes root)))))
 
+;; --- Data Fetching
+
+(s/def ::fetch-bundle-params
+  (s/keys :req-un [::page-id ::file-id]
+          :opt-un [::share-id]))
+
+(defn fetch-bundle
+  [{:keys [file-id share-id] :as params}]
+  (us/assert ::fetch-bundle-params params)
+  (ptk/reify ::fetch-file
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [params' (cond-> {:file-id file-id}
+                      (uuid? share-id) (assoc :share-id share-id))]
+        (->> (rp/query :view-only-bundle params')
+             (rx/mapcat
+              (fn [{:keys [fonts] :as bundle}]
+                (rx/of (df/fonts-fetched fonts)
+                       (bundle-fetched (merge bundle params))))))))))
+
+
 (defn bundle-fetched
-  [{:keys [project file page share-token token libraries users] :as bundle}]
-  (us/verify ::bundle bundle)
-  (ptk/reify ::bundle-fetched
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [objects (:objects page)
-            frames  (extract-frames objects)]
+  [{:keys [project file share-links libraries users permissions] :as bundle}]
+  (let [pages (->> (get-in file [:data :pages])
+                   (map (fn [page-id]
+                          (let [data (get-in file [:data :pages-index page-id])]
+                            [page-id (assoc data :frames (select-frames data))])))
+                   (into {}))]
+
+    (ptk/reify ::bundle-fetched
+      ptk/UpdateEvent
+      (update [_ state]
         (-> state
-            (assoc :viewer-libraries (d/index-by :id libraries))
-            (update :viewer-data assoc
-                    :project project
-                    :objects objects
-                    :users (d/index-by :id users)
-                    :file file
-                    :page page
-                    :frames frames
-                    :token token
-                    :share-token share-token))))))
+            (assoc :share-links share-links)
+            (assoc :viewer {:libraries (d/index-by :id libraries)
+                            :users (d/index-by :id users)
+                            :permissions permissions
+                            :project project
+                            :pages pages
+                            :file file}))))))
 
 (defn fetch-comment-threads
   [{:keys [file-id page-id] :as params}]
@@ -168,32 +172,6 @@
         (->> (rp/query :comments {:thread-id thread-id})
              (rx/map #(partial fetched %)))))))
 
-(defn create-share-link
-  []
-  (ptk/reify ::create-share-link
-    ptk/WatchEvent
-    (watch [_ state _]
-      (let [file-id (:current-file-id state)
-            page-id (:current-page-id state)]
-        (->> (rp/mutation! :create-file-share-token {:file-id file-id
-                                                     :page-id page-id})
-             (rx/map (fn [{:keys [token]}]
-                       #(assoc-in % [:viewer-data :token] token))))))))
-
-(defn delete-share-link
-  []
-  (ptk/reify ::delete-share-link
-    ptk/WatchEvent
-    (watch [_ state _]
-      (let [file-id (:current-file-id state)
-            page-id (:current-page-id state)
-            token   (get-in state [:viewer-data :token])
-            params  {:file-id file-id
-                     :page-id page-id
-                     :token token}]
-        (->> (rp/mutation :delete-file-share-token params)
-             (rx/map (fn [_] #(update % :viewer-data dissoc :token))))))))
-
 ;; --- Zoom Management
 
 (def increase-zoom
@@ -245,29 +223,32 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [route   (:route state)
-            screen  (-> route :data :name keyword)
             qparams (:query-params route)
             pparams (:path-params route)
             index   (:index qparams)]
         (when (pos? index)
           (rx/of
            (dcm/close-thread)
-           (rt/nav screen pparams (assoc qparams :index (dec index)))))))))
+           (rt/nav :viewer pparams (assoc qparams :index (dec index)))))))))
 
 (def select-next-frame
-  (ptk/reify ::select-prev-frame
+  (ptk/reify ::select-next-frame
     ptk/WatchEvent
     (watch [_ state _]
+      (prn "select-next-frame")
       (let [route   (:route state)
-            screen  (-> route :data :name keyword)
-            qparams (:query-params route)
             pparams (:path-params route)
+            qparams (:query-params route)
+
+            page-id (:page-id qparams)
             index   (:index qparams)
-            total   (count (get-in state [:viewer-data :frames]))]
+
+            total   (count (get-in state [:viewer :pages page-id :frames]))]
+
         (when (< index (dec total))
           (rx/of
            (dcm/close-thread)
-           (rt/nav screen pparams (assoc qparams :index (inc index)))))))))
+           (rt/nav :viewer pparams (assoc qparams :index (inc index)))))))))
 
 (s/def ::interactions-mode #{:hide :show :show-on-click})
 
@@ -309,7 +290,7 @@
 
 (defn go-to-frame-by-index
   [index]
-  (ptk/reify ::go-to-frame
+  (ptk/reify ::go-to-frame-by-index
     ptk/WatchEvent
     (watch [_ state _]
       (let [route   (:route state)
@@ -324,12 +305,15 @@
   (ptk/reify ::go-to-frame
     ptk/WatchEvent
     (watch [_ state _]
-      (let [frames  (get-in state [:viewer-data :frames])
+      (let [route   (:route state)
+            qparams (:query-params route)
+            page-id (:page-id qparams)
+
+            frames  (get-in state [:viewer :pages page-id :frames])
             index   (d/index-of-pred frames #(= (:id %) frame-id))]
         (when index
           (rx/of (go-to-frame-by-index index)))))))
 
-
 (defn go-to-section
   [section]
   (ptk/reify ::go-to-section
@@ -340,13 +324,6 @@
             qparams (:query-params route)]
         (rx/of (rt/nav :viewer pparams (assoc qparams :section section)))))))
 
-
-(defn set-current-frame [frame-id]
-  (ptk/reify ::set-current-frame
-    ptk/UpdateEvent
-    (update [_ state]
-      (assoc-in state [:viewer-data :current-frame-id] frame-id))))
-
 (defn deselect-all []
   (ptk/reify ::deselect-all
     ptk/UpdateEvent
@@ -376,7 +353,10 @@
   (ptk/reify ::shift-select-to
     ptk/UpdateEvent
     (update [_ state]
-      (let [objects (get-in state [:viewer-data :objects])
+      (let [route     (:route state)
+            qparams   (:query-params route)
+            page-id   (:page-id qparams)
+            objects   (get-in state [:viewer :pages page-id :objects])
             selection (-> state
                           (get-in [:viewer-local :selected] #{})
                           (conj id))]
@@ -389,8 +369,13 @@
   (ptk/reify ::select-all
     ptk/UpdateEvent
     (update [_ state]
-      (let [objects (get-in state [:viewer-data :objects])
-            frame-id (get-in state [:viewer-data :current-frame-id])
+      (let [route     (:route state)
+            qparams   (:query-params route)
+            page-id   (:page-id qparams)
+            index     (:index qparams)
+            objects   (get-in state [:viewer :pages page-id :objects])
+            frame-id  (get-in state [:viewer :pages page-id :frames index :id])
+
             selection (->> objects
                            (filter #(= (:frame-id (second %)) frame-id))
                            (map first)
@@ -405,18 +390,50 @@
       (let [toggled? (contains? (get-in state [:viewer-local :collapsed]) id)]
         (update-in state [:viewer-local :collapsed] (if toggled? disj conj) id)))))
 
-(defn hover-shape [id hover?]
+(defn hover-shape
+  [id hover?]
   (ptk/reify ::hover-shape
     ptk/UpdateEvent
     (update [_ state]
       (assoc-in state [:viewer-local :hover] (when hover? id)))))
 
+;; --- NAV
 
 (defn go-to-dashboard
-  ([] (go-to-dashboard nil))
-  ([{:keys [team-id]}]
-   (ptk/reify ::go-to-dashboard
-     ptk/WatchEvent
+  []
+  (ptk/reify ::go-to-dashboard
+    ptk/WatchEvent
+    (watch [_ state _]
+      (let [team-id (get-in state [:viewer :project :team-id])
+            params  {:team-id team-id}]
+        (rx/of (rt/nav :dashboard-projects params))))))
+
+(defn go-to-page
+  [page-id]
+  (ptk/reify ::go-to-page
+    ptk/WatchEvent
      (watch [_ state _]
-       (let [team-id (or team-id (get-in state [:viewer-data :project :team-id]))]
-         (rx/of (rt/nav :dashboard-projects {:team-id team-id})))))))
+       (let [route   (:route state)
+             pparams (:path-params route)
+             qparams (-> (:query-params route)
+                         (assoc :index 0)
+                         (assoc :page-id page-id))
+             rname   (get-in route [:data :name])]
+         (rx/of (rt/nav rname pparams qparams))))))
+
+(defn go-to-workspace
+  [page-id]
+  (ptk/reify ::go-to-workspace
+    ptk/WatchEvent
+    (watch [_ state _]
+      (let [project-id (get-in state [:viewer :project :id])
+            file-id    (get-in state [:viewer :file :id])
+            pparams    {:project-id project-id :file-id file-id}
+            qparams    {:page-id page-id}]
+         (rx/of (rt/nav-new-window*
+                 {:rname :workspace
+                  :path-params pparams
+                  :query-params qparams
+                  :name (str "workspace-" file-id)}))))))
+
+

frontend/src/app/main/data/workspace.cljs

@@ -20,6 +20,7 @@
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
+   [app.main.data.events :as ev]
    [app.main.data.messages :as dm]
    [app.main.data.workspace.changes :as dch]
    [app.main.data.workspace.common :as dwc]
@@ -37,6 +38,7 @@
    [app.main.repo :as rp]
    [app.main.streams :as ms]
    [app.main.worker :as uw]
+   [app.util.globals :as ug]
    [app.util.http :as http]
    [app.util.i18n :as i18n]
    [app.util.router :as rt]
@@ -48,7 +50,6 @@
    [potok.core :as ptk]))
 
 ;; (log/set-level! :trace)
-;; --- Specs
 
 (s/def ::shape-attrs ::cp/shape-attrs)
 (s/def ::set-of-string
@@ -87,7 +88,7 @@
     :snap-grid
     :dynamic-alignment})
 
-(def layout-names
+(def layout-presets
   {:assets
    {:del #{:sitemap :layers :document-history }
     :add #{:assets}}
@@ -121,22 +122,31 @@
    :picked-color nil
    :picked-color-select false})
 
-(declare ensure-layout)
-
-(defn initialize-layout
-  [layout-name]
-  (us/verify (s/nilable ::us/keyword) layout-name)
-  (ptk/reify ::initialize-layout
+(defn ensure-layout
+  [lname]
+  (ptk/reify ::ensure-layout
     ptk/UpdateEvent
     (update [_ state]
       (update state :workspace-layout
-              (fn [layout]
-                (or layout default-layout))))
+              (fn [stored]
+                (let [todel (get-in layout-presets [lname :del] #{})
+                      toadd (get-in layout-presets [lname :add] #{})]
+                  (-> stored
+                      (set/difference todel)
+                      (set/union toadd))))))))
+
+(defn setup-layout
+  [lname]
+  (us/verify (s/nilable ::us/keyword) lname)
+  (ptk/reify ::setup-layout
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :workspace-layout #(or % default-layout)))
 
     ptk/WatchEvent
     (watch [_ _ _]
-      (if (and layout-name (contains? layout-names layout-name))
-        (rx/of (ensure-layout layout-name))
+      (if (and lname (contains? layout-presets lname))
+        (rx/of (ensure-layout lname))
         (rx/of (ensure-layout :layers))))))
 
 (defn initialize-file
@@ -171,7 +181,12 @@
                           (->> stream
                                (rx/filter #(= ::dwc/index-initialized %))
                                (rx/first)
-                               (rx/map #(file-initialized bundle)))))))))))
+                               (rx/map #(file-initialized bundle)))))))))
+
+    ptk/EffectEvent
+    (effect [_ _ _]
+      (let [name (str "workspace-" file-id)]
+        (unchecked-set ug/global "name" name)))))
 
 (defn- file-initialized
   [{:keys [file users project libraries] :as bundle}]
@@ -204,15 +219,25 @@
     ptk/UpdateEvent
     (update [_ state]
       (dissoc state
+              :current-file-id
+              :current-project-id
+              :workspace-data
+              :workspace-editor-state
               :workspace-file
-              :workspace-project
+              :workspace-libraries
               :workspace-media-objects
-              :workspace-persistence))
+              :workspace-persistence
+              :workspace-presence
+              :workspace-project
+              :workspace-project
+              :workspace-undo))
 
     ptk/WatchEvent
     (watch [_ _ _]
-      (rx/of (dwn/finalize file-id)
-             ::dwp/finalize))))
+      (rx/merge
+       (rx/of (dwn/finalize file-id))
+       (->> (rx/of ::dwp/finalize)
+            (rx/observe-on :async))))))
 
 (defn initialize-page
   [page-id]
@@ -242,9 +267,10 @@
     (update [_ state]
       (let [page-id (or page-id (get-in state [:workspace-data :pages 0]))
             local   (-> (:workspace-local state)
-                        (dissoc :edition)
-                        (dissoc :edit-path)
-                        (dissoc :selected))]
+                        (dissoc
+                         :edition
+                         :edit-path
+                         :selected))]
         (-> state
             (assoc-in [:workspace-cache page-id] local)
             (dissoc :current-page-id :workspace-local :trimmed-page :workspace-drawing))))))
@@ -265,7 +291,7 @@
       (watch [it state _]
         (let [pages   (get-in state [:workspace-data :pages-index])
               unames  (dwc/retrieve-used-names pages)
-              name    (dwc/generate-unique-name unames "Page")
+              name    (dwc/generate-unique-name unames "Page-1")
 
               rchange {:type :add-page
                        :id id
@@ -339,7 +365,6 @@
                (when (= id (:current-page-id state))
                  go-to-file))))))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; WORKSPACE File Actions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -348,6 +373,10 @@
   [id name]
   {:pre [(uuid? id) (string? name)]}
   (ptk/reify ::rename-file
+    IDeref
+    (-deref [_]
+      {::ev/origin "workspace" :id id :name name})
+
     ptk/UpdateEvent
     (update [_ state]
       (assoc-in state [:workspace-file :name] name))
@@ -364,6 +393,9 @@
 
 ;; --- Viewport Sizing
 
+(declare increase-zoom)
+(declare decrease-zoom)
+(declare set-zoom)
 (declare zoom-to-fit-all)
 
 (defn initialize-viewport
@@ -448,7 +480,6 @@
                                             (update :height #(/ % hprop))
                                             (assoc :left-offset left-offset))))))))))))
 
-
 (defn start-panning []
   (ptk/reify ::start-panning
     ptk/WatchEvent
@@ -475,23 +506,32 @@
       (-> state
           (update :workspace-local dissoc :panning)))))
 
+(defn start-zooming [pt]
+  (ptk/reify ::start-zooming
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [stopper (->> stream (rx/filter (ptk/type? ::finish-zooming)))]
+        (when-not (get-in state [:workspace-local :zooming])
+          (rx/concat
+           (rx/of #(-> % (assoc-in [:workspace-local :zooming] true)))
+           (->> stream
+                (rx/filter ms/pointer-event?)
+                (rx/filter #(= :delta (:source %)))
+                (rx/map :pt)
+                (rx/take-until stopper)
+                (rx/map (fn [delta]
+                          (let [scale (+ 1 (/ (:y delta) 100))] ;; this number may be adjusted after user testing
+                            (set-zoom pt scale)))))))))))
 
-;; --- Toggle layout flag
-
-(defn ensure-layout
-  [layout-name]
-  (assert (contains? layout-names layout-name)
-          (str "unexpected layout name: " layout-name))
-  (ptk/reify ::ensure-layout
+(defn finish-zooming []
+  (ptk/reify ::finish-zooming
     ptk/UpdateEvent
     (update [_ state]
-      (update state :workspace-layout
-              (fn [stored]
-                (let [todel (get-in layout-names [layout-name :del] #{})
-                      toadd (get-in layout-names [layout-name :add] #{})]
-                  (-> stored
-                      (set/difference todel)
-                      (set/union toadd))))))))
+      (-> state
+          (update :workspace-local dissoc :zooming)))))
+
+
+;; --- Toggle layout flag
 
 (defn toggle-layout-flags
   [& flags]
@@ -560,6 +600,16 @@
       (update state :workspace-local
               #(impl-update-zoom % center (fn [z] (max (/ z 1.3) 0.01)))))))
 
+(defn set-zoom
+  [center scale]
+  (ptk/reify ::set-zoom
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :workspace-local
+              #(impl-update-zoom % center (fn [z] (-> (* z scale)
+                                                      (max 0.01)
+                                                      (min 200))))))))
+
 (def reset-zoom
   (ptk/reify ::reset-zoom
     ptk/UpdateEvent
@@ -1049,6 +1099,9 @@
               :group
               (rx/of (dwc/select-shapes (into (d/ordered-set) [(last shapes)])))
 
+              :svg-raw
+              nil
+
               (rx/of (dwc/start-edition-mode id)
                      (dwdp/start-path-edit id)))))))))
 
@@ -1080,7 +1133,7 @@
 (defn align-objects
   [axis]
   (us/verify ::gal/align-axis axis)
-  (ptk/reify :align-objects
+  (ptk/reify ::align-objects
     ptk/WatchEvent
     (watch [_ state _]
       (let [page-id  (:current-page-id state)
@@ -1111,7 +1164,7 @@
 (defn distribute-objects
   [axis]
   (us/verify ::gal/dist-axis axis)
-  (ptk/reify :align-objects
+  (ptk/reify ::distribute-objects
     ptk/WatchEvent
     (watch [_ state _]
       (let [page-id  (:current-page-id state)
@@ -1186,7 +1239,7 @@
          (rx/of (rt/nav' :workspace pparams qparams))))))
   ([page-id]
    (us/verify ::us/uuid page-id)
-   (ptk/reify ::go-to-page
+   (ptk/reify ::go-to-page-2
      ptk/WatchEvent
      (watch [_ state _]
        (let [project-id (:current-project-id state)
@@ -1198,7 +1251,10 @@
 (defn go-to-layout
   [layout]
   (us/verify ::layout-flag layout)
-  (ptk/reify ::go-to-layout
+  (ptk/reify ::set-workspace-layout
+    IDeref
+    (-deref [_] {:layout layout})
+
     ptk/WatchEvent
     (watch [_ state _]
       (let [project-id (get-in state [:workspace-project :id])
@@ -1225,10 +1281,14 @@
      ptk/WatchEvent
      (watch [_ state _]
        (let [{:keys [current-file-id current-page-id]} state
-             params {:file-id (or file-id current-file-id)
-                     :page-id (or page-id current-page-id)}]
+             pparams {:file-id (or file-id current-file-id)}
+             qparams {:page-id (or page-id current-page-id)
+                      :index 0}]
          (rx/of ::dwp/force-persist
-                (rt/nav-new-window :viewer params {:index 0})))))))
+                (rt/nav-new-window* {:rname :viewer
+                                     :path-params pparams
+                                     :query-params qparams
+                                     :name (str "viewer-" (:file-id pparams))})))))))
 
 (defn go-to-dashboard
   ([] (go-to-dashboard nil))
@@ -1242,7 +1302,7 @@
 
 (defn go-to-dashboard-fonts
   []
-   (ptk/reify ::go-to-dashboard
+   (ptk/reify ::go-to-dashboard-fonts
      ptk/WatchEvent
      (watch [_ state _]
        (let [team-id (:current-team-id state)]
@@ -1474,8 +1534,8 @@
          (= :frame (get-in objects [(first selected) :type])))))
 
 (defn- paste-shape
-  [{:keys [selected objects images] :as data} in-viewport?]
-  (letfn [;; Given a file-id and img (part generated by the
+  [{:keys [selected objects images] :as data} in-viewport?] ;; TODO: perhaps rename 'objects' to 'shapes', because it contains only
+  (letfn [;; Given a file-id and img (part generated by the ;;       the shapes to paste, not the whole page tree of shapes
           ;; copy-selected event), uploads the new media.
           (upload-media [file-id imgpart]
             (->> (http/send! {:uri (:file-data imgpart)
@@ -1583,7 +1643,7 @@
 
                   page-id   (:current-page-id state)
                   unames    (-> (wsh/lookup-page-objects state page-id)
-                                (dwc/retrieve-used-names))
+                                (dwc/retrieve-used-names)) ;; TODO: move this calculation inside prepare-duplcate-changes?
 
                   rchanges  (->> (dws/prepare-duplicate-changes objects page-id unames selected delta)
                                  (mapv (partial process-rchange media-idx))

frontend/src/app/main/data/workspace/changes.cljs

@@ -141,6 +141,11 @@
           (try
             (us/assert ::spec/changes redo-changes)
             (us/assert ::spec/changes undo-changes)
+
+            ;; (prn "====== commit-changes ======" path)
+            ;; (cljs.pprint/pprint redo-changes)
+            ;; (cljs.pprint/pprint undo-changes)
+
             (update-in state path cp/process-changes redo-changes false)
 
             (catch :default e

frontend/src/app/main/data/workspace/colors.cljs

@@ -69,7 +69,7 @@
 (defn show-palette
   "Show the palette tool and change the library it uses"
   [selected]
-  (ptk/reify ::change-palette-selected
+  (ptk/reify ::show-palette
     ptk/UpdateEvent
     (update [_ state]
       (-> state