Merge remote-tracking branch 'origin/staging' into develop

backend/deps.edn

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

backend/src/app/config.clj

@@ -9,6 +9,7 @@
   (:refer-clojure :exclude [get])
   (:require
    [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
@@ -46,8 +47,7 @@
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 1
+   :default-blob-version 3
-
    :loggers-zmq-uri "tcp://localhost:45556"
 
    :asserts-enabled false
@@ -99,6 +99,12 @@
    :initial-project-skey "initial-project"
    })
 
+(s/def ::audit-enabled ::us/boolean)
+(s/def ::audit-archive-enabled ::us/boolean)
+(s/def ::audit-archive-uri ::us/string)
+(s/def ::audit-archive-gc-enabled ::us/boolean)
+(s/def ::audit-archive-gc-max-age ::dt/duration)
+
 (s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::asserts-enabled ::us/boolean)
@@ -182,6 +188,11 @@
 (s/def ::config
   (s/keys :opt-un [::secret-key
                    ::allow-demo-users
+                   ::audit-enabled
+                   ::audit-archive-enabled
+                   ::audit-archive-uri
+                   ::audit-archive-gc-enabled
+                   ::audit-archive-gc-max-age
                    ::asserts-enabled
                    ::database-password
                    ::database-uri
@@ -273,9 +284,17 @@
 
 (defn- read-config
   []
-  (->> (read-env "penpot")
+  (try
-       (merge defaults)
+    (->> (read-env "penpot")
-       (us/conform ::config)))
+         (merge defaults)
+         (us/conform ::config))
+    (catch Throwable e
+      (when (ex/ex-info? e)
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
+        (println "Error on validating configuration:")
+        (println (:explain (ex-data e))
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
+      (throw e))))
 
 (def version (v/parse (or (some-> (io/resource "version.txt")
                                   (slurp)

backend/src/app/loggers/activity.clj

@@ -1,127 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) UXBOX Labs SL
-
-(ns app.loggers.activity
-  "Activity registry logger consumer."
-  (:require
-   [app.common.data :as d]
-   [app.common.spec :as us]
-   [app.config :as cf]
-   [app.util.async :as aa]
-   [app.util.http :as http]
-   [app.util.logging :as l]
-   [app.util.time :as dt]
-   [app.util.transit :as t]
-   [app.worker :as wrk]
-   [clojure.core.async :as a]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
-
-(declare process-event)
-(declare handle-event)
-
-(s/def ::uri ::us/string)
-
-(defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor]
-          :opt-un [::uri]))
-
-(defmethod ig/init-key ::reporter
-  [_ {:keys [uri] :as cfg}]
-  (if (string? uri)
-    (do
-      (l/info :msg "intializing activity reporter" :uri uri)
-      (let [xform    (comp (map process-event)
-                           (filter map?))
-            input    (a/chan (a/sliding-buffer 1024) xform)]
-        (a/go-loop []
-          (when-let [event (a/<! input)]
-            (a/<! (handle-event cfg event))
-            (recur)))
-
-        (fn [& [cmd & params]]
-          (case cmd
-            :stop (a/close! input)
-            :submit (when-not (a/offer! input (first params))
-                      (l/warn :msg "activity channel is full"))))))
-    (constantly nil)))
-
-(defmethod ig/halt-key! ::reporter
-  [_ f]
-  (f :stop))
-
-(defn- clean-params
-  "Cleans the params from complex data, only accept strings, numbers and
-  uuids and removing sensitive data such as :password and related
-  props."
-  [params]
-  (let [params (dissoc params :profile-id :session-id :password :old-password)]
-    (reduce-kv (fn [params k v]
-                 (cond-> params
-                   (or (string? v)
-                       (uuid? v)
-                       (number? v))
-                   (assoc k v)))
-               {}
-               params)))
-
-(defn- process-event
-  [{:keys [type name params result] :as event}]
-  (let [profile-id (:profile-id params)]
-    (if (uuid? profile-id)
-      {:type (str "backend:" (d/name type))
-       :name name
-       :timestamp (dt/now)
-       :profile-id profile-id
-       :props (clean-params params)}
-      (cond
-        (= "register-profile" name)
-        {:type (str "backend:" (d/name type))
-         :name name
-         :timestamp (dt/now)
-         :profile-id (:id result)
-         :props (clean-params (:props result))}
-
-        :else nil))))
-
-(defn- send-activity
-  [{:keys [uri tokens]} event i]
-  (try
-    (let [token    (tokens :generate {:iss "authentication"
-                                      :iat (dt/now)
-                                      :uid (:profile-id event)})
-          body     (t/encode {:events [event]})
-          headers  {"content-type" "application/transit+json"
-                    "origin" (cf/get :public-uri)
-                    "cookie" (u/map->query-string {:auth-token token})}
-          params   {:uri uri
-                    :timeout 6000
-                    :method :post
-                    :headers headers
-                    :body body}
-          response (http/send! params)]
-      (if (= (:status response) 204)
-        true
-        (do
-          (l/error :hint "error on sending activity"
-                   :try i
-                   :rsp (pr-str response))
-          false)))
-    (catch Exception e
-      (l/error :hint "error on sending message to loki"
-               :cause e
-               :try i)
-      false)))
-
-(defn- handle-event
-  [{:keys [executor] :as cfg} event]
-  (aa/with-thread executor
-    (loop [i 1]
-      (when (and (not (send-activity cfg event i)) (< i 20))
-        (Thread/sleep (* i 2000))
-        (recur (inc i))))))
-

backend/src/app/loggers/audit.clj

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

backend/src/app/main.clj

@@ -140,7 +140,7 @@
     :msgbus     (ig/ref :app.msgbus/msgbus)
     :rlimits    (ig/ref :app.rlimits/all)
     :public-uri (cf/get :public-uri)
-    :activity   (ig/ref :app.loggers.activity/reporter)}
+    :audit      (ig/ref :app.loggers.audit/collector)}
 
    :app.notifications/handler
    {:msgbus   (ig/ref :app.msgbus/msgbus)
@@ -187,6 +187,14 @@
      {:cron #app/cron "0 0 0 */1 * ?"  ;; daily
       :task :tasks-gc}
 
+     (when (cf/get :audit-archive-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive})
+
+     (when (cf/get :audit-archive-gc-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive-gc})
+
      (when (cf/get :telemetry-enabled)
        {:cron #app/cron "0 0 */6 * * ?" ;; every 6h
         :task :telemetry})]}
@@ -204,7 +212,9 @@
      :storage-recheck    (ig/ref :app.storage/recheck-task)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
-     :session-gc         (ig/ref :app.http.session/gc-task)}}
+     :session-gc         (ig/ref :app.http.session/gc-task)
+     :audit-archive      (ig/ref :app.loggers.audit/archive-task)
+     :audit-archive-gc   (ig/ref :app.loggers.audit/archive-gc-task)}}
 
    :app.emails/sendmail-handler
    {:host             (cf/get :smtp-host)
@@ -220,7 +230,7 @@
 
    :app.tasks.tasks-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :max-age (dt/duration {:hours 24})
+    :max-age cf/deletion-delay
     :metrics (ig/ref :app.metrics/metrics)}
 
    :app.tasks.delete-object/handler
@@ -239,12 +249,12 @@
    :app.tasks.file-media-gc/handler
    {:pool    (ig/ref :app.db/pool)
     :metrics (ig/ref :app.metrics/metrics)
-    :max-age (dt/duration {:hours 48})}
+    :max-age cf/deletion-delay}
 
    :app.tasks.file-xlog-gc/handler
    {:pool    (ig/ref :app.db/pool)
     :metrics (ig/ref :app.metrics/metrics)
-    :max-age (dt/duration {:hours 48})}
+    :max-age cf/deletion-delay}
 
    :app.tasks.telemetry/handler
    {:pool        (ig/ref :app.db/pool)
@@ -263,11 +273,22 @@
    :app.loggers.zmq/receiver
    {:endpoint (cf/get :loggers-zmq-uri)}
 
-   :app.loggers.activity/reporter
+   :app.loggers.audit/collector
-   {:uri      (cf/get :activity-reporter-uri)
+   {:enabled  (cf/get :audit-enabled false)
-    :tokens   (ig/ref :app.tokens/tokens)
+    :pool     (ig/ref :app.db/pool)
     :executor (ig/ref :app.worker/executor)}
 
+   :app.loggers.audit/archive-task
+   {:uri      (cf/get :audit-archive-uri)
+    :enabled  (cf/get :audit-archive-enabled false)
+    :tokens   (ig/ref :app.tokens/tokens)
+    :pool     (ig/ref :app.db/pool)}
+
+   :app.loggers.audit/archive-gc-task
+   {:enabled  (cf/get :audit-archive-gc-enabled false)
+    :max-age  (cf/get :audit-archive-gc-max-age cf/deletion-delay)
+    :pool     (ig/ref :app.db/pool)}
+
    :app.loggers.loki/reporter
    {:uri      (cf/get :loggers-loki-uri)
     :receiver (ig/ref :app.loggers.zmq/receiver)

backend/src/app/migrations.clj

@@ -169,6 +169,9 @@
 
    {:name "0053-add-team-font-variant-table"
     :fn (mg/resource "app/migrations/sql/0053-add-team-font-variant-table.sql")}
+
+   {:name "0054-add-audit-log-table"
+    :fn (mg/resource "app/migrations/sql/0054-add-audit-log-table.sql")}
    ])
 
 

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

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

backend/src/app/msgbus.clj

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

backend/src/app/rpc.clj

@@ -10,6 +10,7 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.loggers.audit :as audit]
    [app.metrics :as mtx]
    [app.rlimits :as rlm]
    [app.util.logging :as l]
@@ -86,28 +87,31 @@
 
 
 (defn- wrap-impl
-  [{:keys [activity] :as cfg} f mdata]
+  [{:keys [audit] :as cfg} f mdata]
   (let [f      (wrap-with-rlimits cfg f mdata)
         f      (wrap-with-metrics cfg f mdata)
         spec   (or (::sv/spec mdata) (s/spec any?))
         auth?  (:auth mdata true)]
-    (l/trace :action "register"
+
-             :name (::sv/name mdata))
+    (l/trace :action "register" :name (::sv/name mdata))
     (fn [params]
       (when (and auth? (not (uuid? (:profile-id params))))
         (ex/raise :type :authentication
                   :code :authentication-required
                   :hint "authentication required for this endpoint"))
+
       (let [params  (us/conform spec params)
             result  (f cfg params)
-            ;; On non authenticated handlers we check the private
+            resultm (meta result)]
-            ;; result that can be found on the metadata.
+        (when (and (::type cfg) (fn? audit))
-            result* (if auth? result (:result (meta result) {}))]
+          (let [profile-id (or (:profile-id params)
-        (when (::type cfg)
+                               (:profile-id result)
-          (activity :submit {:type (::type cfg)
+                               (::audit/profile-id resultm))
-                             :name (::sv/name mdata)
+                props      (d/merge params (::audit/props resultm))]
-                             :params params
+            (audit :submit {:type (::type cfg)
-                             :result result*}))
+                            :name (::sv/name mdata)
+                            :profile-id profile-id
+                            :props (audit/clean-props props)})))
         result))))
 
 (defn- process-method
@@ -124,7 +128,7 @@
                :registry (get-in cfg [:metrics :registry])
                :type :histogram
                :help "Timing of query services."})
-        cfg  (assoc cfg ::mobj mobj)]
+        cfg  (assoc cfg ::mobj mobj ::type "query")]
     (->> (sv/scan-ns 'app.rpc.queries.projects
                      'app.rpc.queries.files
                      'app.rpc.queries.teams
@@ -145,7 +149,7 @@
                :registry (get-in cfg [:metrics :registry])
                :type :histogram
                :help "Timing of mutation services."})
-        cfg  (assoc cfg ::mobj mobj ::type :mutation)]
+        cfg  (assoc cfg ::mobj mobj ::type "mutation")]
     (->> (sv/scan-ns 'app.rpc.mutations.demo
                      'app.rpc.mutations.media
                      'app.rpc.mutations.profile
@@ -164,10 +168,10 @@
 (s/def ::storage some?)
 (s/def ::session map?)
 (s/def ::tokens fn?)
-(s/def ::activity some?)
+(s/def ::audit (s/nilable fn?))
 
 (defmethod ig/pre-init-spec ::rpc [_]
-  (s/keys :req-un [::storage ::session ::tokens ::activity
+  (s/keys :req-un [::storage ::session ::tokens ::audit
                    ::mtx/metrics ::rlm/rlimits ::db/pool]))
 
 (defmethod ig/init-key ::rpc

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

@@ -14,6 +14,7 @@
    [app.db :as db]
    [app.emails :as eml]
    [app.http.oauth :refer [extract-props]]
+   [app.loggers.audit :as audit]
    [app.media :as media]
    [app.rpc.mutations.projects :as projects]
    [app.rpc.mutations.teams :as teams]
@@ -103,7 +104,8 @@
         (with-meta resp
           {:transform-response ((:create session) (:id profile))
            :before-complete (annotate-profile-register metrics profile)
-           :result profile}))
+           ::audit/props (:props profile)
+           ::audit/profile-id (:id profile)}))
 
       ;; If no token is provided, send a verification email
       (let [vtoken (tokens :generate
@@ -132,7 +134,8 @@
 
         (with-meta profile
           {:before-complete (annotate-profile-register metrics profile)
-           :result profile})))))
+           ::audit/props (:props profile)
+           ::audit/profile-id (:id profile)})))))
 
 (defn email-domain-in-whitelist?
   "Returns true if email's domain is in the given whitelist or if given

backend/src/app/util/async.clj

@@ -81,7 +81,11 @@
               (recur (a/timeout max-batch-age) init)))
 
           (nil? val)
-          (a/close! out)
+          (if (empty? buf)
+            (a/close! out)
+            (do
+              (a/offer! out [:timeout buf])
+              (a/close! out)))
 
           (identical? port in)
           (let [buf (conj buf val)]
@@ -91,3 +95,7 @@
                 (recur (a/timeout max-batch-age) init))
               (recur tch buf))))))
     out))
+
+(defn thread-sleep
+  [ms]
+  (Thread/sleep ms))

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

@@ -283,11 +283,6 @@
                              center
                              (:width points-temp-dim)
                              (:height points-temp-dim))
-                            (cond-> round-coords?
-                              (-> (update :x #(mth/precision % 0))
-                                  (update :y #(mth/precision % 0))
-                                  (update :width #(mth/precision % 0))
-                                  (update :height #(mth/precision % 0))))
                             (update :width max 1)
                             (update :height max 1))
 
@@ -295,6 +290,13 @@
 
         [matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
 
+        rect-shape (cond-> rect-shape
+                     round-coords?
+                     (-> (update :x mth/round)
+                         (update :y mth/round)
+                         (update :width mth/round)
+                         (update :height mth/round)))
+
         shape (cond
                 (= :path (:type shape))
                 (-> shape
@@ -302,7 +304,7 @@
 
                 :else
                 (-> shape
-                    (merge  rect-shape)))]
+                    (merge rect-shape)))]
     (as-> shape $
       (update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
       (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))

common/app/common/pages/init.cljc

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

exporter/src/app/browser.cljs

@@ -6,14 +6,17 @@
 
 (ns app.browser
   (:require
+   ["puppeteer-cluster" :as ppc]
+   [app.common.data :as d]
    [app.config :as cf]
    [lambdaisland.glogi :as log]
-   [promesa.core :as p]
+   [promesa.core :as p]))
-   ["puppeteer-cluster" :as ppc]))
 
 ;; --- BROWSER API
 
-(def USER-AGENT
+(def default-timeout 30000)
+(def default-viewport {:width 1920 :height 1080 :scale 1})
+(def default-user-agent
   (str "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 "
        "(KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36"))
 
@@ -23,15 +26,25 @@
                           (let [page (unchecked-get props "page")]
                             (f page)))))
 
-(defn emulate!
+(defn set-cookie!
-  [page {:keys [viewport user-agent scale]
+  [page {:keys [key value domain]}]
-         :or {user-agent USER-AGENT
+  (.setCookie ^js page #js {:name key
-              scale 1}}]
+                            :value value
-  (let [[width height] viewport]
+                            :domain domain}))
-    (.emulate ^js page #js {:viewport #js {:width width
+
-                                           :height height
+(defn configure-page!
-                                           :deviceScaleFactor scale}
+  [page {:keys [timeout cookie user-agent viewport]}]
-                            :userAgent user-agent})))
+  (let [timeout    (or timeout default-timeout)
+        user-agent (or user-agent default-user-agent)
+        viewport   (d/merge default-viewport viewport)]
+    (p/do!
+     (.setViewport ^js page #js {:width (:width viewport)
+                                 :height (:height viewport)
+                                 :deviceScaleFactor (:scale viewport)})
+     (.setUserAgent ^js page user-agent)
+     (.setDefaultTimeout ^js page timeout)
+     (when cookie
+       (set-cookie! page cookie)))))
 
 (defn navigate!
   ([page url] (navigate! page url nil))
@@ -43,10 +56,9 @@
   [page ms]
   (.waitForTimeout ^js page ms))
 
-
 (defn wait-for
   ([page selector] (wait-for page selector nil))
-  ([page selector {:keys [visible] :or {visible false}}]
+  ([page selector {:keys [visible timeout] :or {visible false timeout 10000}}]
    (.waitForSelector ^js page selector #js {:visible visible})))
 
 (defn screenshot
@@ -71,11 +83,6 @@
   [frame selector]
   (.$$ ^js frame selector))
 
-(defn set-cookie!
-  [page {:keys [key value domain]}]
-  (.setCookie ^js page #js {:name key
-                            :value value
-                            :domain domain}))
 
 ;; --- BROWSER STATE
 

exporter/src/app/renderer/bitmap.cljs

@@ -40,16 +40,20 @@
 
           (screenshot [page uri cookie]
             (log/info :uri uri)
-            (p/do!
+            (let [viewport {:width 1920
-             (bw/emulate! page {:viewport [1920 1080]
+                            :height 1080
-                                 :scale scale})
+                            :scale scale}
-             (bw/set-cookie! page cookie)
+                  options  {:viewport viewport
-             (bw/navigate! page uri)
+                            :cookie cookie}]
-             (bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
+              (p/do!
-             (p/let [dom (bw/select page "#screenshot")]
+               (bw/configure-page! page options)
-               (case type
+               (bw/navigate! page uri)
-                 :png  (bw/screenshot dom {:omit-background? true :type type})
+               (bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
-                 :jpeg (bw/screenshot dom {:omit-background? false :type type})))))]
+               (bw/wait-for page "#screenshot")
+               (p/let [dom (bw/select page "#screenshot")]
+                 (case type
+                   :png  (bw/screenshot dom {:omit-background? true :type type})
+                   :jpeg (bw/screenshot dom {:omit-background? false :type type}))))))]
 
     (bw/exec! browser handle)))
 

exporter/src/app/renderer/svg.cljs

@@ -253,15 +253,19 @@
               result))
 
           (render-in-page [page {:keys [uri cookie] :as rctx}]
-            (p/do!
+            (let [viewport {:width 1920
-             (bw/emulate! page {:viewport [1920 1080]
+                            :height 1080
-                                 :scale 4})
+                            :scale 4}
-             (bw/set-cookie! page cookie)
+                  options  {:viewport viewport
-             (bw/navigate! page uri)
+                            :timeout 15000
-             ;; (bw/wait-for page "#screenshot foreignObject" {:visible true})
+                            :cookie cookie}]
-             (bw/sleep page 2000)
+              (p/do!
-             ;; (bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
+               (bw/configure-page! page options)
-             page))
+               (bw/navigate! page uri)
+               (bw/wait-for page "#screenshot")
+               (bw/sleep page 2000)
+               ;; (bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
+               page)))
 
           (handle [rctx page]
             (p/let [page (render-in-page page rctx)]

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

@@ -164,12 +164,6 @@
       }
     }
 
-    .selection-rect {
-      fill: rgba(235, 215, 92, 0.1);
-      stroke: #000000;
-      stroke-width: 0.1px;
-    }
-
     .render-shapes {
       position: absolute;
     }

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

@@ -552,7 +552,7 @@
     ptk/UpdateEvent
     (update [_ state]
       (update state :workspace-local
-              #(impl-update-zoom % center (fn [z] (min (* z 1.1) 200)))))))
+              #(impl-update-zoom % center (fn [z] (min (* z 1.3) 200)))))))
 
 (defn decrease-zoom
   [center]
@@ -560,7 +560,7 @@
     ptk/UpdateEvent
     (update [_ state]
       (update state :workspace-local
-              #(impl-update-zoom % center (fn [z] (max (* z 0.9) 0.01)))))))
+              #(impl-update-zoom % center (fn [z] (max (/ z 1.3) 0.01)))))))
 
 (def reset-zoom
   (ptk/reify ::reset-zoom

frontend/src/app/main/ui/workspace/viewport.cljs

@@ -149,7 +149,7 @@
     (hooks/setup-cursor cursor alt? panning drawing-tool drawing-path? path-editing?)
     (hooks/setup-resize layout viewport-ref)
     (hooks/setup-keyboard alt? ctrl?)
-    (hooks/setup-hover-shapes page-id move-stream selected objects transform selected ctrl? hover hover-ids)
+    (hooks/setup-hover-shapes page-id move-stream selected objects transform selected ctrl? hover hover-ids zoom)
     (hooks/setup-viewport-modifiers modifiers selected objects render-ref)
     (hooks/setup-shortcuts path-editing? drawing-path?)
     (hooks/setup-active-frames objects vbox hover active-frames)
@@ -315,5 +315,6 @@
           {:selected selected}])
 
        (when show-selrect?
-         [:& widgets/selection-rect {:data selrect}])]]]))
+         [:& widgets/selection-rect {:data selrect
+                                     :zoom zoom}])]]]))
 

frontend/src/app/main/ui/workspace/viewport/hooks.cljs

@@ -90,12 +90,12 @@
   (hooks/use-stream ms/keyboard-alt #(reset! alt? %))
   (hooks/use-stream ms/keyboard-ctrl #(reset! ctrl? %)))
 
-(defn setup-hover-shapes [page-id move-stream selected objects transform selected ctrl? hover hover-ids]
+(defn setup-hover-shapes [page-id move-stream selected objects transform selected ctrl? hover hover-ids zoom]
   (let [query-point
         (mf/use-callback
          (mf/deps page-id)
          (fn [point]
-           (let [rect (gsh/center->rect point 8 8)]
+           (let [rect (gsh/center->rect point (/ 5 zoom) (/ 5 zoom))]
              (uw/ask-buffered!
               {:cmd :selection/query
                :page-id page-id

frontend/src/app/main/ui/workspace/viewport/widgets.cljs

@@ -64,13 +64,19 @@
 
 (mf/defc selection-rect
   {:wrap [mf/memo]}
-  [{:keys [data] :as props}]
+  [{:keys [data zoom] :as props}]
   (when data
     [:rect.selection-rect
      {:x (:x data)
       :y (:y data)
       :width (:width data)
-      :height (:height data)}]))
+      :height (:height data)
+      :style {;; Primary with 0.1 opacity
+              :fill "rgb(49, 239, 184, 0.1)"
+
+              ;; Primary color
+              :stroke "rgb(49, 239, 184)"
+              :stroke-width (/ 1 zoom)}}]))
 
 ;; Ensure that the label has always the same font
 ;; size, regardless of zoom