✨ Add telemetry for events performance measures (#7457)

2026-04-25 19:28:12 +00:00 · 2025-10-08 14:03:09 +02:00 · 2025-10-08 14:03:09 +02:00 · 40e9a78f67
commit 40e9a78f67
parent 551a25661f
11 changed files with 356 additions and 49 deletions
--- a/frontend/src/app/main/data/changes.cljs
+++ b/frontend/src/app/main/data/changes.cljs
@ -12,6 +12,7 @@
   [app.common.time :as ct]
   [app.common.types.shape-tree :as ctst]
   [app.common.uuid :as uuid]
+   [app.main.data.event :as ev]
   [app.main.data.helpers :as dsh]
   [app.main.worker :as mw]
   [beicon.v2.core :as rx]
@ -173,6 +174,8 @@
         tags #{}}
    :as params}]
  (ptk/reify ::commit-changes
+    ev/PerformanceEvent
+
    ptk/WatchEvent
    (watch [_ state _]
      (let [file-id     (or file-id (:current-file-id state))
--- a/frontend/src/app/main/data/event.cljs
+++ b/frontend/src/app/main/data/event.cljs
@ -8,15 +8,20 @@
  (:require
   ["ua-parser-js" :as ua]
   [app.common.data :as d]
+   [app.common.data.macros :as dm]
   [app.common.json :as json]
   [app.common.logging :as l]
+   [app.common.math :as math]
   [app.common.time :as ct]
   [app.config :as cf]
+   [app.main.refs :as refs]
   [app.main.repo :as rp]
+   [app.main.store :as st]
   [app.util.globals :as g]
   [app.util.http :as http]
   [app.util.i18n :as i18n]
   [app.util.object :as obj]
+   [app.util.perf :as perf]
   [app.util.storage :as storage]
   [beicon.v2.core :as rx]
   [beicon.v2.operators :as rxo]
@ -34,6 +39,28 @@
 ;; Defines the time window (in ms) within events belong to the same session.
 (def session-timeout (* 1000 60 30))

+
+;; Min time for a long task to be reported to telemetry
+(def min-longtask-time 1000)
+
+;; Min time between long task reports
+(def debounce-longtask-time 1000)
+
+;; Min time for a long task to be reported to telemetry
+(def min-browser-event-time 1000)
+
+;; Min time between long task reports
+(def debounce-browser-event-time 1000)
+
+;; Min time for a long task to be reported to telemetry
+(def min-performace-event-time 1000)
+
+;; Min time between long task reports
+(def debounce-performance-event-time 1000)
+
+;; Def micro-benchmark iterations
+(def micro-benchmark-iterations 1e6)
+
 ;; --- CONTEXT

 (defn- collect-context
@ -78,6 +105,8 @@
 (defprotocol Event
  (-data [_] "Get event data"))

+(defprotocol PerformanceEvent)
+
 (defn- coerce-to-string
  [v]
  (cond
@ -148,6 +177,48 @@
         :context context
         :props   props}))))

+(defn performance-payload
+  ([result]
+   (let [props      (aget result 0)
+         profile-id (aget result 1)]
+     (performance-payload profile-id props)))
+  ([profile-id props]
+   (let [{:keys [performance-info]} @st/state]
+     {:type    "action"
+      :name    "performance"
+      :context (merge @context performance-info)
+      :props   props
+      :profile-id profile-id})))
+
+(defn- process-performance-event
+  [result]
+  (let [event      (aget result 0)
+        profile-id (aget result 1)]
+
+    (if (and (satisfies? PerformanceEvent event)
+             (exists? js/globalThis)
+             (exists? (.-requestAnimationFrame js/globalThis))
+             (exists? (.-scheduler js/globalThis))
+             (exists? (.-postTask (.-scheduler js/globalThis))))
+      (rx/create
+       (fn [subs]
+         (let [start (perf/timestamp)]
+           (js/requestAnimationFrame
+            #(js/scheduler.postTask
+              (fn []
+                (let [time (- (perf/timestamp) start)]
+                  (when (> time min-performace-event-time)
+                    (rx/push!
+                     subs
+                     (performance-payload
+                      profile-id
+                      {::event (str (ptk/type event))
+                       :time time}))))
+                (rx/end! subs))
+              #js {"priority" "user-blocking"})))
+         nil))
+      (rx/empty))))
+
 (defn- process-event
  [event]
  (cond
@ -183,10 +254,126 @@

    (rx/of nil)))

+
+(defn performance-observer-event-stream
+  []
+  (if (and (exists? js/globalThis)
+           (exists? (.-PerformanceObserver js/globalThis)))
+    (rx/create
+     (fn [subs]
+       (let [observer
+             (js/PerformanceObserver.
+              (fn [list]
+                (run!
+                 (fn [entry]
+                   (when (and (= "event" (.-entryType entry))
+                              (> (.-duration entry) min-browser-event-time))
+                     (rx/push!
+                      subs
+                      {::event :observer-event
+                       :duration (.-duration entry)
+                       :event-name (.-name entry)})))
+                 (.getEntries list))))]
+         (.observe observer #js {:entryTypes #js ["event"]})
+         (fn []
+           (.disconnect observer)))))
+    (rx/empty)))
+
+(defn performance-observer-longtask-stream
+  []
+  (if (and (exists? js/globalThis)
+           (exists? (.-PerformanceObserver js/globalThis)))
+    (rx/create
+     (fn [subs]
+       (let [observer
+             (js/PerformanceObserver.
+              (fn [list]
+                (run!
+                 (fn [entry]
+                   (when (and (= "longtask" (.-entryType entry))
+                              (> (.-duration entry) min-longtask-time))
+                     (rx/push! subs
+                               {::event :observer-longtask
+                                :duration (.-duration entry)})))
+                 (.getEntries list))))]
+         (.observe observer #js {:entryTypes #js ["longtask"]})
+         (fn []
+           (.disconnect observer)))))
+    (rx/empty)))
+
+(defn- save-performance-info
+  []
+  (ptk/reify ::save-performance-info
+    ptk/UpdateEvent
+    (update [_ state]
+      (letfn [(count-shapes [file]
+                (->> file :data :pages-index
+                     (reduce-kv
+                      (fn [sum _ page]
+                        (+ sum (count (:objects page))))
+                      0)))
+              (count-library-data [files {:keys [id]}]
+                (let [data (dm/get-in files [id :data])]
+                  {:components (count (:components data))
+                   :colors (count (:colors data))
+                   :typographies (count (:typographies data))}))]
+        (let [file-id (get state :current-file-id)
+              file (get-in state [:files file-id])
+              file-size (count-shapes file)
+
+              libraries
+              (-> (refs/select-libraries (:files state) (:id file))
+                  (d/update-vals (partial count-library-data (:files state))))
+
+              lib-sizes
+              (->> libraries
+                   (reduce-kv
+                    (fn [acc _ {:keys [components colors typographies]}]
+                      (-> acc
+                          (update :components + components)
+                          (update :colors + colors)
+                          (update :typographies + typographies)))
+                    {}))]
+          (update state :performance-info
+                  (fn [info]
+                    (-> info
+                        (assoc :file-size file-size)
+                        (assoc :library-sizes lib-sizes)
+                        (assoc :file-start-time (perf/now))))))))))
+
+(defn store-performace-info
+  []
+  (letfn [(micro-benchmark [state]
+            (let [start (perf/now)]
+              (loop [i micro-benchmark-iterations]
+                (when-not (zero? i)
+                  (* (math/sin i) (math/sqrt i))
+                  (recur (dec i))))
+              (let [end (perf/now)]
+                (update state :performance-info assoc :bench-result (- end start)))))]
+
+    (ptk/reify ::store-performace-info
+      ptk/UpdateEvent
+      (update [_ state]
+        (-> state
+            micro-benchmark
+            (assoc-in [:performance-info :app-start-time] (perf/now))))
+
+      ptk/WatchEvent
+      (watch [_ _ stream]
+        (->> stream
+             (rx/filter (ptk/type? :app.main.data.workspace/all-libraries-resolved))
+             (rx/take 1)
+             (rx/map save-performance-info))))))
+
 (defn initialize
  []
  (when (contains? cf/flags :audit-log)
    (ptk/reify ::initialize
+      ptk/WatchEvent
+      (watch [_ _ _]
+        (rx/of (store-performace-info)))
+
      ptk/EffectEvent
      (effect [_ _ stream]
        (let [session (atom nil)
@ -223,13 +410,30 @@
                         (fn []
                           (l/debug :hint "audit persistence terminated"))))

-          (->> stream
-               (rx/with-latest-from profile)
-               (rx/map (fn [result]
-                         (let [event      (aget result 0)
-                               profile-id (aget result 1)]
-                           (some-> (process-event event)
-                                   (update :profile-id #(or % profile-id))))))
+          (->> (rx/merge
+                (->> stream
+                     (rx/with-latest-from profile)
+                     (rx/map (fn [result]
+                               (let [event      (aget result 0)
+                                     profile-id (aget result 1)]
+                                 (some-> (process-event event)
+                                         (update :profile-id #(or % profile-id)))))))
+
+                (->> (performance-observer-event-stream)
+                     (rx/with-latest-from profile)
+                     (rx/map performance-payload)
+                     (rx/debounce debounce-browser-event-time))
+
+                (->> (performance-observer-longtask-stream)
+                     (rx/with-latest-from profile)
+                     (rx/map performance-payload)
+                     (rx/debounce debounce-longtask-time))
+
+                (->> stream
+                     (rx/with-latest-from profile)
+                     (rx/merge-map process-performance-event)
+                     (rx/debounce debounce-performance-event-time)))
+
               (rx/filter :profile-id)
               (rx/map (fn [event]
                         (let [session* (or @session (ct/now))
--- a/frontend/src/app/main/data/workspace.cljs
+++ b/frontend/src/app/main/data/workspace.cljs
@ -187,30 +187,37 @@
    (update [_ state]
      (update state :files assoc (:id library) library))))

+
+
+
 (defn- fetch-libraries
  [file-id features]
  (ptk/reify ::fetch-libries
    ptk/WatchEvent
    (watch [_ _ _]
-      (->> (rp/cmd! :get-file-libraries {:file-id file-id})
-           (rx/mapcat
-            (fn [libraries]
-              (rx/concat
-               (rx/of (dwl/libraries-fetched file-id libraries))
-               (rx/merge
-                (->> (rx/from libraries)
-                     (rx/merge-map
-                      (fn [{:keys [id synced-at]}]
-                        (->> (rp/cmd! :get-file {:id id :features features})
-                             (rx/map #(assoc % :synced-at synced-at :library-of file-id)))))
-                     (rx/mapcat resolve-file)
-                     (rx/map library-resolved))
-                (->> (rx/from libraries)
-                     (rx/map :id)
-                     (rx/mapcat (fn [file-id]
-                                  (rp/cmd! :get-file-object-thumbnails {:file-id file-id :tag "component"})))
-                     (rx/map dwl/library-thumbnails-fetched)))
-               (rx/of (check-libraries-synchronozation file-id libraries)))))))))
+      (rx/concat
+       (->> (rp/cmd! :get-file-libraries {:file-id file-id})
+            (rx/mapcat
+             (fn [libraries]
+               (rx/concat
+                (rx/of (dwl/libraries-fetched file-id libraries))
+                (rx/merge
+                 (->> (rx/from libraries)
+                      (rx/merge-map
+                       (fn [{:keys [id synced-at]}]
+                         (->> (rp/cmd! :get-file {:id id :features features})
+                              (rx/map #(assoc % :synced-at synced-at :library-of file-id)))))
+                      (rx/mapcat resolve-file)
+                      (rx/map library-resolved))
+                 (->> (rx/from libraries)
+                      (rx/map :id)
+                      (rx/mapcat (fn [file-id]
+                                   (rp/cmd! :get-file-object-thumbnails {:file-id file-id :tag "component"})))
+                      (rx/map dwl/library-thumbnails-fetched)))
+                (rx/of (check-libraries-synchronozation file-id libraries))))))
+
+       ;; This events marks that all the libraries have been resolved
+       (rx/of (ptk/data-event ::all-libraries-resolved))))))

 (defn- workspace-initialized
  [file-id]
--- a/frontend/src/app/main/data/workspace/selection.cljs
+++ b/frontend/src/app/main/data/workspace/selection.cljs
@ -131,6 +131,8 @@
  ([id toggle?]
   (dm/assert! (uuid? id))
   (ptk/reify ::select-shape
+     ev/PerformanceEvent
+
     ptk/UpdateEvent
     (update [_ state]
       (-> state
@ -248,6 +250,8 @@
        (d/ordered-set? ids)))

  (ptk/reify ::select-shapes
+    ev/PerformanceEvent
+
    ptk/UpdateEvent
    (update [_ state]
      (let [objects (dsh/lookup-page-objects state)
@ -267,6 +271,8 @@
 (defn select-all
  []
  (ptk/reify ::select-all
+    ev/PerformanceEvent
+
    ptk/WatchEvent
    (watch [_ state _]
      (let [;; Make the select-all aware of the focus mode; in this
--- a/frontend/src/app/main/data/workspace/viewport.cljs
+++ b/frontend/src/app/main/data/workspace/viewport.cljs
@ -14,6 +14,7 @@
   [app.common.geom.rect :as gpr]
   [app.common.geom.shapes :as gsh]
   [app.common.math :as mth]
+   [app.main.data.event :as ev]
   [app.main.data.helpers :as dsh]
   [app.util.mouse :as mse]
   [beicon.v2.core :as rx]
@ -113,6 +114,8 @@
   (fn? y))

  (ptk/reify ::update-viewport-position
+    ev/PerformanceEvent
+
    ptk/UpdateEvent
    (update [_ state]
      (update-in state [:workspace-local :vbox]
--- a/frontend/src/app/main/data/workspace/zoom.cljs
+++ b/frontend/src/app/main/data/workspace/zoom.cljs
@ -14,6 +14,7 @@
   [app.common.geom.point :as gpt]
   [app.common.geom.rect :as grc]
   [app.common.geom.shapes :as gsh]
+   [app.main.data.event :as ev]
   [app.main.data.helpers :as dsh]
   [app.main.streams :as ms]
   [app.util.mouse :as mse]
@ -38,6 +39,8 @@
   (increase-zoom ::auto))
  ([center]
   (ptk/reify ::increase-zoom
+     ev/PerformanceEvent
+
     ptk/UpdateEvent
     (update [_ state]
       (let [center (if (= center ::auto) @ms/mouse-position center)]
@ -49,6 +52,8 @@
   (decrease-zoom ::auto))
  ([center]
   (ptk/reify ::decrease-zoom
+     ev/PerformanceEvent
+
     ptk/UpdateEvent
     (update [_ state]
       (let [center (if (= center ::auto) @ms/mouse-position center)]
@ -60,6 +65,8 @@
   (set-zoom nil scale))
  ([center scale]
   (ptk/reify ::set-zoom
+     ev/PerformanceEvent
+
     ptk/UpdateEvent
     (update [_ state]
       (let [vp (dm/get-in state [:workspace-local :vbox])
--- a/frontend/src/app/main/store.cljs
+++ b/frontend/src/app/main/store.cljs
@ -11,6 +11,7 @@
   [app.util.timers :as tm]
   [beicon.v2.core :as rx]
   [beicon.v2.operators :as rxo]
+   [cuerdas.core :as str]
   [okulary.core :as l]
   [potok.v2.core :as ptk]))

@ -28,6 +29,28 @@
 (def on-event identity)

 (def ^:dynamic *debug-events* false)
+(def ^:dynamic *debug-events-time* false)
+
+(def current-measure (atom nil))
+
+(defn measure-time-to-render [event]
+  (if @current-measure
+    (swap! current-measure conj event)
+
+    (let [start (js/performance.now)]
+      (reset! current-measure [event])
+
+      (tm/raf
+       #(js/scheduler.postTask
+         (fn []
+           (let [time (- (js/performance.now) start)]
+             ;; Only print sets that last over 1second
+             (when (> time 1000)
+               (println
+                (str time "|" (str/join "," @current-measure)))))
+           (reset! current-measure nil))
+
+         #js {"priority" "user-blocking"})))))

 ;; Only created in development build
 (when *assert*
@ -38,6 +61,8 @@
      :app.main.data.workspace.selection/change-hover-state})

  (set! on-event (fn [e]
+                   (when (and *debug-events-time* (ptk/event? e))
+                     (measure-time-to-render (ptk/type e)))
                   (when (and *debug-events*
                              (ptk/event? e)
                              (not (debug-exclude-events (ptk/type e))))
--- a/frontend/src/app/util/debug.cljs
+++ b/frontend/src/app/util/debug.cljs
@ -4,7 +4,9 @@
 ;;
 ;; Copyright (c) KALEIDOS INC

-(ns app.util.debug)
+(ns app.util.debug
+  (:require
+   [app.main.store :as st]))

 (defonce state (atom #{#_:events}))

@ -95,7 +97,19 @@
    :gl-context

    ;; Show viewbox
-    :wasm-viewbox})
+    :wasm-viewbox
+
+    ;; Event times
+    :events-times})
+
+(defn handle-change
+  []
+  (set! st/*debug-events* (contains? @state :events))
+  (set! st/*debug-events-time* (contains? @state :events-times)))
+
+(when *assert*
+  (handle-change)
+  (add-watch state :watcher handle-change))

 (defn enable!
  [option]
--- a/frontend/src/app/util/http.cljs
+++ b/frontend/src/app/util/http.cljs
@ -13,6 +13,7 @@
   [app.config :as cfg]
   [app.util.cache :as c]
   [app.util.globals :as globals]
+   [app.util.perf :as perf]
   [app.util.webapi :as wapi]
   [beicon.v2.core :as rx]
   [cuerdas.core :as str]
@ -54,6 +55,10 @@
  {"x-frontend-version" (:full cfg/version)
   "x-client" (str "penpot-frontend/" (:full cfg/version))})

+;; Storage to save the average time of the requests
+(defonce network-averages
+  (atom {}))
+
 (defn fetch
  [{:keys [method uri query headers body mode omit-default-headers credentials]
    :or {mode :cors
@ -88,17 +93,29 @@
                              :redirect "follow"
                              :credentials credentials
                              :referrerPolicy "no-referrer"
-                              :signal signal}]
+                              :signal signal}
+
+           start (perf/timestamp)]

       (-> (js/fetch (str uri) params)
-           (p/then (fn [response]
-                     (vreset! abortable? false)
-                     (.next ^js subscriber response)
-                     (.complete ^js subscriber)))
-           (p/catch (fn [err]
-                      (vreset! abortable? false)
-                      (when-not @unsubscribed?
-                        (.error ^js subscriber err)))))
+           (p/then
+            (fn [response]
+              (vreset! abortable? false)
+              (.next ^js subscriber response)
+              (.complete ^js subscriber)))
+           (p/catch
+            (fn [err]
+              (vreset! abortable? false)
+              (when-not @unsubscribed?
+                (.error ^js subscriber err))))
+           (p/finally
+             (fn []
+               (let [{:keys [count average] :or {count 0 average 0}} (get @network-averages (:path uri))
+                     current-time (- (perf/timestamp) start)
+                     average (+ (* average (/ count (inc count)))
+                                (/ current-time (inc count)))
+                     count (inc count)]
+                 (swap! network-averages assoc (:path uri) {:count count :average average})))))
       (fn []
         (vreset! unsubscribed? true)
         (when @abortable?
--- a/frontend/src/app/util/perf.cljs
+++ b/frontend/src/app/util/perf.cljs
@ -157,3 +157,15 @@
  (let [p1 (now)]
    #(js/Math.floor (- (now) p1))))

+(defn measure-time-to-render [event]
+  (if (and (exists? js/globalThis)
+           (exists? (.-requestAnimationFrame js/globalThis))
+           (exists? (.-scheduler js/globalThis))
+           (exists? (.-postTask (.-scheduler js/globalThis))))
+    (let [start (timestamp)]
+      (js/requestAnimationFrame
+       #(js/scheduler.postTask
+         (fn []
+           (let [end (timestamp)]
+             (println (str "[" event "]" (- end start)))))
+         #js {"priority" "user-blocking"})))))
--- a/frontend/src/debug.cljs
+++ b/frontend/src/debug.cljs
@ -32,6 +32,7 @@
   [app.main.store :as st]
   [app.util.debug :as dbg]
   [app.util.dom :as dom]
+   [app.util.http :as http]
   [app.util.object :as obj]
   [app.util.timers :as timers]
   [beicon.v2.core :as rx]
@ -58,15 +59,27 @@
 (defn enable!
  [option]
  (dbg/enable! option)
-  (when (= :events option)
-    (set! st/*debug-events* true))
+  (case option
+    :events
+    (set! st/*debug-events* true)
+
+    :events-times
+    (set! st/*debug-events-time* true)
+
+    nil)
  (js* "app.main.reinit()"))

 (defn disable!
  [option]
  (dbg/disable! option)
-  (when (= :events option)
-    (set! st/*debug-events* false))
+  (case option
+    :events
+    (set! st/*debug-events* false)
+
+    :events-times
+    (set! st/*debug-events-time* false)
+
+    nil)
  (js* "app.main.reinit()"))

 (defn ^:export toggle-debug
@ -278,14 +291,6 @@
  ([shape-id show-ids show-touched] (dump-subtree' @st/state shape-id show-ids show-touched false))
  ([shape-id show-ids show-touched show-modified] (dump-subtree' @st/state shape-id show-ids show-touched show-modified)))

-(when *assert*
-  (defonce debug-subscription
-    (->> st/stream
-         (rx/filter ptk/event?)
-         (rx/filter (fn [s] (and (dbg/enabled? :events)
-                                 (not (debug-exclude-events (ptk/type s))))))
-         (rx/subs! #(println "[stream]: " (ptk/repr-event %))))))
-
 (defn ^:export apply-changes
  "Takes a Transit JSON changes"
  [^string changes*]
@ -447,3 +452,7 @@
 (defn ^:export set-shape-ref
  [id shape-ref]
  (st/emit! (set-shape-ref* id shape-ref)))
+
+(defn ^:export network-averages
+  []
+  (.log js/console (clj->js @http/network-averages)))