✨ Add improvements to telemetry task

backend/src/app/loggers/audit.clj

@@ -188,14 +188,14 @@
                 :profile-id (::profile-id event)
                 :ip-addr (::ip-addr event)
                 :context (::context event)
-                :props (::props event)}]
+                :props (::props event)}
+        tnow   (dt/now)]
 
     (when (contains? cf/flags :audit-log)
       ;; NOTE: this operation may cause primary key conflicts on inserts
       ;; because of the timestamp precission (two concurrent requests), in
       ;; this case we just retry the operation.
-      (let [tnow   (dt/now)
+      (let [params (-> params
-            params (-> params
                        (assoc :created-at tnow)
                        (assoc :tracked-at tnow)
                        (update :props db/tjson)
@@ -204,6 +204,23 @@
                        (assoc :source "backend"))]
         (db/insert! cfg :audit-log params)))
 
+    (when (and (or (contains? cf/flags :telemetry)
+                   (cf/get :telemetry-enabled))
+               (not (contains? cf/flags :audit-log)))
+      ;; NOTE: this operation may cause primary key conflicts on inserts
+      ;; because of the timestamp precission (two concurrent requests), in
+      ;; this case we just retry the operation.
+      ;;
+      ;; NOTE: this is only executed when general audit log is disabled
+      (let [params (-> params
+                       (assoc :created-at tnow)
+                       (assoc :tracked-at tnow)
+                       (assoc :props (db/tjson {}))
+                       (assoc :context (db/tjson {}))
+                       (assoc :ip-addr (db/inet "0.0.0.0"))
+                       (assoc :source "backend"))]
+        (db/insert! cfg :audit-log params)))
+
     (when (and (contains? cf/flags :webhooks)
                (::webhooks/event? event))
       (let [batch-key     (::webhooks/batch-key event)

backend/src/app/tasks/telemetry.clj

@@ -22,13 +22,182 @@
    [promesa.exec :as px]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; TASK ENTRY POINT
+;; IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare get-stats)
+(defn- send!
-(declare send!)
+  [cfg data]
-(declare get-subscriptions-newsletter-updates)
+  (let [request {:method :post
-(declare get-subscriptions-newsletter-news)
+                 :uri (cf/get :telemetry-uri)
+                 :headers {"content-type" "application/json"}
+                 :body (json/encode-str data)}
+        response (http/req! cfg request)]
+    (when (> (:status response) 206)
+      (ex/raise :type :internal
+                :code :invalid-response
+                :response-status (:status response)
+                :response-body (:body response)))))
+
+(defn- get-subscriptions-newsletter-updates
+  [conn]
+  (let [sql "SELECT email FROM profile where props->>'~:newsletter-updates' = 'true'"]
+    (->> (db/exec! conn [sql])
+         (mapv :email))))
+
+(defn- get-subscriptions-newsletter-news
+  [conn]
+  (let [sql "SELECT email FROM profile where props->>'~:newsletter-news' = 'true'"]
+    (->> (db/exec! conn [sql])
+         (mapv :email))))
+
+(defn- get-num-teams
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM team"]) :count))
+
+(defn- get-num-projects
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM project"]) :count))
+
+(defn- get-num-files
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM file"]) :count))
+
+(defn- get-num-file-changes
+  [conn]
+  (let [sql (str "SELECT count(*) AS count "
+                 "  FROM file_change "
+                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
+    (-> (db/exec-one! conn [sql]) :count)))
+
+(defn- get-num-touched-files
+  [conn]
+  (let [sql (str "SELECT count(distinct file_id) AS count "
+                 "  FROM file_change "
+                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
+    (-> (db/exec-one! conn [sql]) :count)))
+
+(defn- get-num-users
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM profile"]) :count))
+
+(defn- get-num-fonts
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM team_font_variant"]) :count))
+
+(defn- get-num-comments
+  [conn]
+  (-> (db/exec-one! conn ["SELECT count(*) AS count FROM comment"]) :count))
+
+(def sql:team-averages
+  "with projects_by_team AS (
+     SELECT t.id, count(p.id) AS num_projects
+       FROM team AS t
+       LEFT JOIN project AS p ON (p.team_id = t.id)
+      GROUP BY 1
+   ), files_by_project AS (
+     SELECT p.id, count(f.id) AS num_files
+       FROM project AS p
+       LEFT JOIN file AS f ON (f.project_id = p.id)
+      GROUP BY 1
+   ), comment_threads_by_file AS (
+     SELECT f.id, count(ct.id) AS num_comment_threads
+       FROM file AS f
+       LEFT JOIN comment_thread AS ct ON (ct.file_id = f.id)
+      GROUP BY 1
+   ), users_by_team AS (
+     SELECT t.id, count(tp.profile_id) AS num_users
+       FROM team AS t
+       LEFT JOIN team_profile_rel AS tp ON(tp.team_id = t.id)
+      GROUP BY 1
+   )
+   SELECT (SELECT avg(num_projects)::integer FROM projects_by_team) AS avg_projects_on_team,
+          (SELECT max(num_projects)::integer FROM projects_by_team) AS max_projects_on_team,
+          (SELECT avg(num_files)::integer FROM files_by_project) AS avg_files_on_project,
+          (SELECT max(num_files)::integer FROM files_by_project) AS max_files_on_project,
+          (SELECT avg(num_comment_threads)::integer FROM comment_threads_by_file) AS avg_comment_threads_on_file,
+          (SELECT max(num_comment_threads)::integer FROM comment_threads_by_file) AS max_comment_threads_on_file,
+          (SELECT avg(num_users)::integer FROM users_by_team) AS avg_users_on_team,
+          (SELECT max(num_users)::integer FROM users_by_team) AS max_users_on_team")
+
+(defn- get-team-averages
+  [conn]
+  (->> [sql:team-averages]
+       (db/exec-one! conn)))
+
+(defn- get-enabled-auth-providers
+  [conn]
+  (let [sql  (str "SELECT auth_backend AS backend, count(*) AS total "
+                  "  FROM profile GROUP BY 1")
+        rows (db/exec! conn [sql])]
+    (->> rows
+         (map (fn [{:keys [backend total]}]
+                (let [backend (or backend "penpot")]
+                  [(keyword (str "auth-backend-" backend))
+                   total])))
+         (into {}))))
+
+(defn- get-jvm-stats
+  []
+  (let [^Runtime runtime (Runtime/getRuntime)]
+    {:jvm-heap-current (.totalMemory runtime)
+     :jvm-heap-max     (.maxMemory runtime)
+     :jvm-cpus         (.availableProcessors runtime)
+     :os-arch          (System/getProperty "os.arch")
+     :os-name          (System/getProperty "os.name")
+     :os-version       (System/getProperty "os.version")
+     :user-tz          (System/getProperty "user.timezone")}))
+
+(def ^:private sql:get-counters
+  "SELECT name, count(*) AS count
+     FROM audit_log
+    WHERE source = 'backend'
+      AND tracked_at >= date_trunc('day', now())
+    GROUP BY 1
+    ORDER BY 2 DESC")
+
+(defn- get-action-counters
+  [conn]
+  (let [counters (->> (db/exec! conn [sql:get-counters])
+                      (d/index-by (comp keyword :name) :count))
+        total    (reduce + 0 (vals counters))]
+    {:total-accomulated-events total
+     :event-counters counters}))
+
+(def ^:private sql:clean-counters
+  "DELETE FROM audit_log
+    WHERE ip_addr = '0.0.0.0'::inet -- we know this is from telemetry
+      AND tracked_at < (date_trunc('day', now()) - '1 day'::interval)")
+
+(defn- clean-counters-data!
+  [conn]
+  (when-not (contains? cf/flags :audit-log)
+    (db/exec-one! conn [sql:clean-counters])))
+
+(defn- get-stats
+  [conn]
+  (let [referer (if (cf/get :telemetry-with-taiga)
+                  "taiga"
+                  (cf/get :telemetry-referer))]
+    (-> {:referer             referer
+         :public-uri          (cf/get :public-uri)
+         :total-teams         (get-num-teams conn)
+         :total-projects      (get-num-projects conn)
+         :total-files         (get-num-files conn)
+         :total-users         (get-num-users conn)
+         :total-fonts         (get-num-fonts conn)
+         :total-comments      (get-num-comments conn)
+         :total-file-changes  (get-num-file-changes conn)
+         :total-touched-files (get-num-touched-files conn)}
+        (merge
+         (get-team-averages conn)
+         (get-jvm-stats)
+         (get-enabled-auth-providers conn)
+         (get-action-counters conn))
+        (d/without-nils))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TASK ENTRY POINT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defmethod ig/pre-init-spec ::handler [_]
   (s/keys :req [::http/client
@@ -48,6 +217,10 @@
           data     {:subscriptions subs
                     :version (:full cf/version)
                     :instance-id (:instance-id props)}]
+
+      (when enabled?
+        (clean-counters-data! pool))
+
       (cond
         ;; If we have telemetry enabled, then proceed the normal
         ;; operation.
@@ -63,7 +236,8 @@
         ;; onboarding dialog or the profile section, then proceed to
         ;; send a limited telemetry data, that consists in the list of
         ;; subscribed emails and the running penpot version.
-        (seq subs)
+        (or (seq (:newsletter-updates subs))
+            (seq (:newsletter-news subs)))
         (do
           (when send?
             (px/sleep (rand-int 10000))
@@ -72,151 +246,3 @@
 
         :else
         data))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; IMPL
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- send!
-  [cfg data]
-  (let [request {:method :post
-                 :uri (cf/get :telemetry-uri)
-                 :headers {"content-type" "application/json"}
-                 :body (json/encode-str data)}
-        response (http/req! cfg request)]
-    (when (> (:status response) 206)
-      (ex/raise :type :internal
-                :code :invalid-response
-                :response-status (:status response)
-                :response-body (:body response)))))
-
-(defn- get-subscriptions-newsletter-updates
-  [conn]
-  (let [sql "select email from profile where props->>'~:newsletter-updates' = 'true'"]
-    (->> (db/exec! conn [sql])
-         (mapv :email))))
-
-(defn- get-subscriptions-newsletter-news
-  [conn]
-  (let [sql "select email from profile where props->>'~:newsletter-news' = 'true'"]
-    (->> (db/exec! conn [sql])
-         (mapv :email))))
-
-(defn- retrieve-num-teams
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from team;"]) :count))
-
-(defn- retrieve-num-projects
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from project;"]) :count))
-
-(defn- retrieve-num-files
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from file;"]) :count))
-
-(defn- retrieve-num-file-changes
-  [conn]
-  (let [sql (str "select count(*) as count "
-                 "  from file_change "
-                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
-    (-> (db/exec-one! conn [sql]) :count)))
-
-(defn- retrieve-num-touched-files
-  [conn]
-  (let [sql (str "select count(distinct file_id) as count "
-                 "  from file_change "
-                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
-    (-> (db/exec-one! conn [sql]) :count)))
-
-(defn- retrieve-num-users
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from profile;"]) :count))
-
-(defn- retrieve-num-fonts
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from team_font_variant;"]) :count))
-
-(defn- retrieve-num-comments
-  [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from comment;"]) :count))
-
-(def sql:team-averages
-  "with projects_by_team as (
-     select t.id, count(p.id) as num_projects
-       from team as t
-       left join project as p on (p.team_id = t.id)
-      group by 1
-   ), files_by_project as (
-     select p.id, count(f.id) as num_files
-       from project as p
-       left join file as f on (f.project_id = p.id)
-      group by 1
-   ), comment_threads_by_file as (
-     select f.id, count(ct.id) as num_comment_threads
-       from file as f
-       left join comment_thread as ct on (ct.file_id = f.id)
-      group by 1
-   ), users_by_team as (
-     select t.id, count(tp.profile_id) as num_users
-       from team as t
-       left join team_profile_rel as tp on(tp.team_id = t.id)
-      group by 1
-   )
-   select (select avg(num_projects)::integer from projects_by_team) as avg_projects_on_team,
-          (select max(num_projects)::integer from projects_by_team) as max_projects_on_team,
-          (select avg(num_files)::integer from files_by_project) as avg_files_on_project,
-          (select max(num_files)::integer from files_by_project) as max_files_on_project,
-          (select avg(num_comment_threads)::integer from comment_threads_by_file) as avg_comment_threads_on_file,
-          (select max(num_comment_threads)::integer from comment_threads_by_file) as max_comment_threads_on_file,
-          (select avg(num_users)::integer from users_by_team) as avg_users_on_team,
-          (select max(num_users)::integer from users_by_team) as max_users_on_team;")
-
-(defn- retrieve-team-averages
-  [conn]
-  (->> [sql:team-averages]
-       (db/exec-one! conn)))
-
-(defn- retrieve-enabled-auth-providers
-  [conn]
-  (let [sql  (str "select auth_backend as backend, count(*) as total "
-                  "  from profile group by 1")
-        rows (db/exec! conn [sql])]
-    (->> rows
-         (map (fn [{:keys [backend total]}]
-                (let [backend (or backend "penpot")]
-                  [(keyword (str "auth-backend-" backend))
-                   total])))
-         (into {}))))
-
-(defn- retrieve-jvm-stats
-  []
-  (let [^Runtime runtime (Runtime/getRuntime)]
-    {:jvm-heap-current (.totalMemory runtime)
-     :jvm-heap-max     (.maxMemory runtime)
-     :jvm-cpus         (.availableProcessors runtime)
-     :os-arch          (System/getProperty "os.arch")
-     :os-name          (System/getProperty "os.name")
-     :os-version       (System/getProperty "os.version")
-     :user-tz          (System/getProperty "user.timezone")}))
-
-(defn get-stats
-  [conn]
-  (let [referer (if (cf/get :telemetry-with-taiga)
-                  "taiga"
-                  (cf/get :telemetry-referer))]
-    (-> {:referer        referer
-         :public-uri     (cf/get :public-uri)
-         :total-teams    (retrieve-num-teams conn)
-         :total-projects (retrieve-num-projects conn)
-         :total-files    (retrieve-num-files conn)
-         :total-users    (retrieve-num-users conn)
-         :total-fonts    (retrieve-num-fonts conn)
-         :total-comments (retrieve-num-comments conn)
-         :total-file-changes  (retrieve-num-file-changes conn)
-         :total-touched-files (retrieve-num-touched-files conn)}
-        (d/merge
-         (retrieve-team-averages conn)
-         (retrieve-jvm-stats)
-         (retrieve-enabled-auth-providers conn))
-        (d/without-nils))))
-