github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-05-10 18:48:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

🎉 Add telemetry anonymous event collection

Browse Source 
Rewrite the audit logging subsystem to support three operating modes and
add anonymous telemetry event collection:

Modes:
- A (audit-log only): events persisted with full context
- B (audit-log + telemetry): same as A, plus events are collected for
  telemetry shipping
- C (telemetry-only): events stored anonymously with PII stripped,
  telemetry flag active, audit-log flag inactive

Audit system refactoring (app.loggers.audit):
- Replace qualified map keys (::audit/name etc.) with plain keywords
- Rename submit! -> submit, insert! -> insert, prepare-event ->
  prepare-rpc-event
- Add submit* as a lower-level public API
- Add process-event dispatch function that handles all three modes and
  webhooks in a single tx-run!
- Add :id to event schema (auto-generated if omitted)
- Add filter-telemetry-props: anonymises event props per event type.
  Keeps UUID/boolean/number values; for login/identify events preserves
  lang, auth-backend, email-domain; for navigate events preserves route,
  file-id, team-id, page-id; instance-start trigger passes through.
- Add filter-telemetry-context: retains only safe context keys.
  Backend: version, initiator, client-version, client-user-agent.
  Frontend: browser, os, locale, screen metrics, event-origin.
- Timestamps truncated to day precision via ct/truncate for telemetry
  storage
- PII stripped: props emptied, ip-addr zeroed, session-linking and
  access-token fields removed from context

Config (app.config):
- Derive :enable-telemetry flag from telemetry-enabled config option

Email utilities (app.email):
- Add email/clean and email/get-domain helper functions for domain
  extraction from email addresses

Setup (app.setup):
- Emit instance-start trigger event at system startup
- Simplify handle-instance-id (remove read-only check)

RPC layer (app.rpc):
- wrap-audit now activates when :telemetry flag is set
- Add :request-id to RPC params context for event correlation

RPC commands (management, teams_invitations, verify_token, OIDC auth,
webhooks): migrate all audit call sites to use the new plain-key API

SREPL (app.srepl.main):
- Migrate all audit/insert! calls to audit/insert with plain keys

Telemetry task (app.tasks.telemetry):
- Restructure legacy report into make-legacy-request; distinguish
  payload type as :telemetry-legacy-report
- Add collect-and-send-audit-events: loop fetching up to 10,000 rows
  per iteration, encodes and sends each page, deletes on success,
  stops immediately on failure for retry
- Add send-event-batch: POSTs fressian+zstd batch (base64 via
  blob/encode-str) to the telemetry endpoint with instance-id per event
- Add gc-telemetry-events: enforces 100,000-row safety cap by dropping
  oldest rows first
- Add delete-sent-events: deletes successfully shipped rows by id

Blob utilities (app.util.blob):
- Add encode-str/decode-str: combine fressian+zstd encoding with URL-
  safe base64 for JSON-safe string transport

Database:
- Add migration 0145: index on audit_log (source, created_at ASC) for
  efficient telemetry batch collection queries

Frontend:
- Always initialize event system regardless of :audit-log flag
- Defer auth events (signin identify) to after profile is set
- Refactor event subsystem for telemetry support

Tests (21 test vars, 94 assertions in tasks-telemetry-test):
- Cover all code paths: disabled/enabled telemetry, no-events no-op,
  happy-path batch send and delete, failure retention, payload anonymity,
  context stripping, timestamp day precision, batch encoding round-trip,
  multi-page iteration, GC cap enforcement, partial failure handling
- blob encode-str/decode-str round-trip tests (14 test vars)
- RPC audit integration tests (5 test vars)

Signed-off-by: Andrey Antukh <niwi@niwi.nz>
This commit is contained in:
Andrey Antukh 2026-04-20 18:04:38 +00:00
parent 79937027eb
commit affb6aec84
25 changed files with 2189 additions and 533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
backend/AGENTS.md
View File

@ -8,7 +8,10 @@ Redis for messaging/caching.
## General Guidelines
To ensure consistency across the Penpot JVM stack, all contributions must adhere
to these criteria:
to these criteria.
IMPORTANT: all CLI commands should be executed under backend/
subdirectory for make them work correctly.
### 1. Testing & Validation
@ -21,7 +24,7 @@ to these criteria:
### 2. Code Quality & Formatting
* **Linting:** All code must pass `clj-kondo` checks (run `pnpm run lint:clj`)
* **Linting:** All code must pass linter checks (run `pnpm run lint:clj` or `pnpm run lint` on the repository root)
* **Formatting:** All the code must pass the formatting check (run `pnpm run
check-fmt`). Use `pnpm run fmt` to fix formatting issues. Avoid "dirty"
diffs caused by unrelated whitespace changes.

12
backend/src/app/auth/oidc.clj
View File

@ -818,12 +818,12 @@
props (audit/profile->props profile)
context (d/without-nils {:external-session-id (:external-session-id info)})]
(audit/submit! cfg {::audit/type "action"
::audit/name "login-with-oidc"
::audit/profile-id (:id profile)
::audit/ip-addr (inet/parse-request request)
::audit/props props
::audit/context context})
(audit/submit cfg {:type "action"
:name "login-with-oidc"
:profile-id (:id profile)
:ip-addr (inet/parse-request request)
:props props
:context context})
(->> (redirect-to-verify-token token)
(sxf request)))))

15
backend/src/app/config.clj
View File

@ -259,11 +259,16 @@
[config]
(let [public-uri (c/get config :public-uri)
public-uri (some-> public-uri (u/uri))
extra-flags (if (and public-uri
(= (:scheme public-uri) "http")
(not= (:host public-uri) "localhost"))
#{:disable-secure-session-cookies}
#{})]
extra-flags (cond-> #{}
;; When public-uri is http (non-localhost), disable secure cookies
(and public-uri
(= (:scheme public-uri) "http")
(not= (:host public-uri) "localhost"))
(conj :disable-secure-session-cookies)
;; When telemetry-enabled config is true, add :telemetry flag
(true? (c/get config :telemetry-enabled))
(conj :enable-telemetry))]
(flags/parse flags/default extra-flags (:flags config))))
(defn read-env

19
backend/src/app/email.clj
View File

@ -31,6 +31,25 @@
jakarta.mail.Transport
java.util.Properties))
(defn clean
"Clean and normalizes email address string"
[email]
(let [email (str/lower email)
email (if (str/starts-with? email "mailto:")
(subs email 7)
email)
email (if (or (str/starts-with? email "<")
(str/ends-with? email ">"))
(str/trim email "<>")
email)]
email))
(defn get-domain
[email]
(let [email (clean email)
[_ domain] (str/split email "@" 2)]
domain))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EMAIL IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

441
backend/src/app/loggers/audit.clj
View File

@ -16,12 +16,12 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.email :as email]
[app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.loggers.audit.tasks :as-alias tasks]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.retry :as rtry]
[app.setup :as-alias setup]
[app.util.inet :as inet]
[app.util.services :as-alias sv]
@ -33,6 +33,60 @@
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private safe-backend-context-keys
#{:version
:initiator
:client-version
:client-user-agent})
(def ^:private safe-frontend-context-keys
#{:version
:locale
:browser
:browser-version
:engine
:engine-version
:os
:os-version
:device-type
:device-arch
:screen-width
:screen-height
:screen-color-depth
:screen-orientation
:event-origin
:event-namespace
:event-symbol})
(def profile-props
[:id
:is-active
:is-muted
:auth-backend
:email
:default-team-id
:default-project-id
:fullname
:lang])
(def ^:private event-keys
#{:id
:name
:type
:profile-id
:ip-addr
:props
:context
:source
:tracked-at
:created-at})
(def reserved-props
#{:session-id
:password
:old-password
:token})
(defn extract-utm-params
"Extracts additional data from params and namespace them under
`penpot` ns."
@ -47,17 +101,6 @@
(assoc (->> sk str/kebab (keyword "penpot")) v))))]
(reduce-kv process-param {} params)))
(def profile-props
[:id
:is-active
:is-muted
:auth-backend
:email
:default-team-id
:default-project-id
:fullname
:lang])
(defn profile->props
[profile]
(-> profile
@ -65,12 +108,6 @@
(merge (:props profile))
(d/without-nils)))
(def reserved-props
#{:session-id
:password
:old-password
:token})
(defn clean-props
[props]
(into {}
@ -121,15 +158,16 @@
(def ^:private schema:event
[:map {:title "AuditEvent"}
[::type ::sm/text]
[::name ::sm/text]
[::profile-id ::sm/uuid]
[::ip-addr {:optional true} ::sm/text]
[::props {:optional true} [:map-of :keyword :any]]
[::context {:optional true} [:map-of :keyword :any]]
[::tracked-at {:optional true} ::ct/inst]
[::created-at {:optional true} ::ct/inst]
[::source {:optional true} ::sm/text]
[:id {:optional true} ::sm/uuid]
[:type ::sm/text]
[:name ::sm/text]
[:profile-id ::sm/uuid]
[:props [:map-of :keyword :any]]
[:context [:map-of :keyword :any]]
[:tracked-at ::ct/inst]
[:created-at ::ct/inst]
[:source ::sm/text]
[:ip-addr {:optional true} ::sm/text]
[::webhooks/event? {:optional true} ::sm/boolean]
[::webhooks/batch-timeout {:optional true} ::ct/duration]
[::webhooks/batch-key {:optional true}
@ -141,7 +179,157 @@
(def valid-event?
(sm/validator schema:event))
(defn prepare-event
(defn- prepare-context-from-request
"Prepare backend event context from request"
[request]
(let [client-event-origin (get-client-event-origin request)
client-version (get-client-version request)
client-user-agent (get-client-user-agent request)
session-id (get-external-session-id request)
key-id (::http/auth-key-id request)
token-id (::actoken/id request)
token-type (::actoken/type request)]
{:external-session-id session-id
:initiator (or key-id "app")
:access-token-id (some-> token-id str)
:access-token-type (some-> token-type str)
:client-event-origin client-event-origin
:client-user-agent client-user-agent
:client-version client-version
:version (:full cf/version)}))
(defn- append-audit-entry
[cfg params]
(let [params (-> params
(assoc :id (uuid/next))
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet))
params (select-keys params event-keys)]
(db/insert! cfg :audit-log params)))
(def ^:private xf:filter-telemetry-props
"Transducer that keeps only map entries whose values are UUIDs."
(filter (fn [[k v]]
(and (simple-keyword? k)
(or (uuid? v) (boolean? v) (number? v))))))
(declare filter-telemetry-props)
(declare filter-telemetry-context)
(defn- process-event
[cfg event]
(when (contains? cf/flags :audit-log-logger)
(l/log! ::l/logger "app.audit"
::l/level :info
:profile-id (str (:profile-id event))
:ip-addr (str (:ip-addr event))
:type (:type event)
:name (:name event)
:props (json/encode (:props event) :key-fn json/write-camel-key)
:context (json/encode (:context event) :key-fn json/write-camel-key)))
(when (contains? cf/flags :audit-log)
(append-audit-entry cfg event))
(when (contains? cf/flags :telemetry)
;; NOTE: when both audit-log and telemetry are enabled, events are stored
;; twice: once with full details (above) and once stripped of props and
;; ip-addr, tagged with source="telemetry" so the telemetry task can
;; collect and ship them. The profile-id is preserved (UUIDs are already
;; anonymous random identifiers). Only a safe subset of context fields
;; is kept: initiator, version, client-version and client-user-agent.
;; Timestamps are truncated to day precision to avoid leaking exact event
;; timing.
(let [event (-> event
(filter-telemetry-props)
(filter-telemetry-context)
(update :created-at ct/truncate :days)
(update :tracked-at ct/truncate :days)
(assoc :source "telemetry:backend")
(assoc :ip-addr "0.0.0.0"))]
(append-audit-entry cfg event)))
(when (and (contains? cf/flags :webhooks)
(::webhooks/event? event))
(let [batch-key (::webhooks/batch-key event)
batch-timeout (::webhooks/batch-timeout event)
label (dm/str "rpc:" (:name event))
label (cond
(ifn? batch-key) (dm/str label ":" (batch-key (::rpc/params event)))
(string? batch-key) (dm/str label ":" batch-key)
:else label)
dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! (-> cfg
(assoc ::wrk/task :process-webhook-event)
(assoc ::wrk/queue :webhooks)
(assoc ::wrk/max-retries 0)
(assoc ::wrk/delay (or batch-timeout 0))
(assoc ::wrk/dedupe dedupe?)
(assoc ::wrk/label label)
(assoc ::wrk/params (-> event
(dissoc :source)
(dissoc :context)
(dissoc :ip-addr)
(dissoc :type)))))))
event)
(defn submit*
"A public API, lower-leve lhan submit, assumes all required fields are filled"
[cfg event]
(try
(let [event (check-event event)]
(db/tx-run! cfg process-event event))
(catch Throwable cause
(l/error :hint "unexpected error processing event" :cause cause))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn filter-telemetry-props
[{:keys [source name props type] :as params}]
(cond
(or (and (= source "frontend")
(= type "identify"))
(and (= source "backend")
(or (= name "login-with-oidc")
(= name "login-with-password")
(= name "register-profile")
(= name "update-profile"))))
(let [props' (into {} xf:filter-telemetry-props props)
props' (-> props'
(assoc :lang (:lang props))
(assoc :auth-backend (:auth-backend props))
(assoc :email-domain (email/get-domain (:email props)))
(d/without-nils))]
(assoc params :props props'))
(and (= source "backend")
(= type "trigger")
(= name "instance-start"))
params
(and (= source "frontend")
(= type "action")
(= name "navigate"))
(assoc params :props (select-keys props [:route :file-id :team-id :page-id]))
:else
(let [props (into {} xf:filter-telemetry-props props)]
(assoc params :props props))))
(defn filter-telemetry-context
[{:keys [source context] :as params}]
(let [context (case source
"backend" (select-keys context safe-backend-context-keys)
"frontend" (select-keys context safe-frontend-context-keys)
{})]
(assoc params :context context)))
(defn prepare-rpc-event
[cfg mdata params result]
(let [resultm (meta result)
request (-> params meta ::http/request)
@ -154,23 +342,29 @@
(merge params (::props resultm)))
(clean-props))
context (merge (::context resultm)
(prepare-context-from-request request))
context (-> (::context resultm)
(merge (prepare-context-from-request request))
(assoc :request-id (::rpc/request-id params))
(d/without-nils))
ip-addr (inet/parse-request request)
module (get cfg ::rpc/module)]
{::type (or (::type resultm)
(::rpc/type cfg))
::name (or (::name resultm)
(let [sname (::sv/name mdata)]
(if (not= module "main")
(str module "-" sname)
sname)))
{:type (or (::type resultm)
(::rpc/type cfg))
:name (or (::name resultm)
(let [sname (::sv/name mdata)]
(if (not= module "main")
(str module "-" sname)
sname)))
::profile-id profile-id
::ip-addr ip-addr
::props props
::context context
:profile-id profile-id
:ip-addr ip-addr
:props props
:context context
:created-at (::rpc/request-at params)
:tracked-at (::rpc/request-at params)
;; NOTE: for batch-key lookup we need the params as-is
;; because the rpc api does not need to know the
@ -190,148 +384,49 @@
(::webhooks/event? resultm)
false)}))
(defn- prepare-context-from-request
"Prepare backend event context from request"
[request]
(let [client-event-origin (get-client-event-origin request)
client-version (get-client-version request)
client-user-agent (get-client-user-agent request)
session-id (get-external-session-id request)
key-id (::http/auth-key-id request)
token-id (::actoken/id request)
token-type (::actoken/type request)]
(d/without-nils
{:external-session-id session-id
:initiator (or key-id "app")
:access-token-id (some-> token-id str)
:access-token-type (some-> token-type str)
:client-event-origin client-event-origin
:client-user-agent client-user-agent
:client-version client-version
:version (:full cf/version)})))
(defn event-from-rpc-params
"Create a base event skeleton with pre-filled some important
data that can be extracted from RPC params object"
[params]
(let [context (some-> params meta ::http/request prepare-context-from-request)
event {::type "action"
::profile-id (or (::rpc/profile-id params) uuid/zero)
::ip-addr (::rpc/ip-addr params)}]
(cond-> event
(some? context)
(assoc ::context context))))
(let [context (some-> params meta ::http/request prepare-context-from-request)
context (assoc context :request-id (::rpc/request-id params))
request-at (::rpc/request-at params)]
{:type "action"
:profile-id (::rpc/profile-id params)
:created-at request-at
:tracked-at request-at
:ip-addr (::rpc/ip-addr params)
:context (d/without-nils context)}))
(defn- event->params
[event]
(let [params {:id (uuid/next)
:name (::name event)
:type (::type event)
:profile-id (::profile-id event)
:ip-addr (::ip-addr event)
:context (::context event {})
:props (::props event {})
:source "backend"}
tnow (::tracked-at event)]
(cond-> params
(some? tnow)
(assoc :tracked-at tnow))))
(defn- append-audit-entry
[cfg params]
(let [params (-> params
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet))]
(db/insert! cfg :audit-log params)))
(defn- handle-event!
(defn submit
"Submit an event to be registered under audit-log subsystem"
[cfg event]
(let [tnow (ct/now)
params (-> (event->params event)
(assoc :created-at tnow)
(update :tracked-at #(or % tnow)))]
(let [tnow (ct/now)
event (-> event
(assoc :created-at tnow)
(update :profile-id d/nilv uuid/zero)
(update :tracked-at d/nilv tnow)
(update :ip-addr d/nilv "0.0.0.0")
(update :props d/nilv {})
(update :context d/nilv {})
(assoc :source "backend")
(d/without-nils))]
(submit* cfg event)))
(when (contains? cf/flags :audit-log-logger)
(l/log! ::l/logger "app.audit"
::l/level :info
:profile-id (str (::profile-id event))
:ip-addr (str (::ip-addr event))
:type (::type event)
:name (::name event)
:props (json/encode (::props event) :key-fn json/write-camel-key)
:context (json/encode (::context event) :key-fn json/write-camel-key)))
(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.
(append-audit-entry cfg 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 :props {})
(assoc :context {}))]
(append-audit-entry cfg params)))
(when (and (contains? cf/flags :webhooks)
(::webhooks/event? event))
(let [batch-key (::webhooks/batch-key event)
batch-timeout (::webhooks/batch-timeout event)
label (dm/str "rpc:" (:name params))
label (cond
(ifn? batch-key) (dm/str label ":" (batch-key (::rpc/params event)))
(string? batch-key) (dm/str label ":" batch-key)
:else label)
dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! (-> cfg
(assoc ::wrk/task :process-webhook-event)
(assoc ::wrk/queue :webhooks)
(assoc ::wrk/max-retries 0)
(assoc ::wrk/delay (or batch-timeout 0))
(assoc ::wrk/dedupe dedupe?)
(assoc ::wrk/label label)
(assoc ::wrk/params (-> params
(dissoc :source)
(dissoc :context)
(dissoc :ip-addr)
(dissoc :type)))))))
params))
(defn submit!
"Submit audit event to the collector."
[cfg event]
(try
(let [event (-> (d/without-nils event)
(check-event))
cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6)
(assoc ::rtry/label "persist-audit-log"))]
(rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable cause
(l/error :hint "unexpected error processing event" :cause cause))))
(defn insert!
(defn insert
"Submit audit event to the collector, intended to be used only from
command line helpers because this skips all webhooks and telemetry
logic."
[cfg event]
(when (contains? cf/flags :audit-log)
(let [event (-> (d/without-nils event)
(let [tnow (ct/now)
event (-> event
(assoc :created-at tnow)
(update :tracked-at d/nilv tnow)
(update :profile-id d/nilv uuid/zero)
(update :props d/nilv {})
(update :context d/nilv {})
(assoc :source "backend")
(select-keys event-keys)
(check-event))]
(db/run! cfg (fn [cfg]
(let [tnow (ct/now)
params (-> (event->params event)
(assoc :created-at tnow)
(update :tracked-at #(or % tnow)))]
(append-audit-entry cfg params)))))))
(db/run! cfg append-audit-entry event))))

14
backend/src/app/loggers/webhooks.clj
View File

@ -70,14 +70,14 @@
(fn [{:keys [props] :as task}]
(let [items (lookup-webhooks cfg props)
event {::audit/profile-id (:profile-id props)
::audit/name "webhook"
::audit/type "trigger"
::audit/props {:name (get props :name)
:event-id (get props :id)
:total-affected (count items)}}]
event {:profile-id (:profile-id props)
:name "webhook"
:type "trigger"
:props {:name (get props :name)
:event-id (get props :id)
:total-affected (count items)}}]
(audit/insert! cfg event)
(audit/insert cfg event)
(when items
(l/trc :hint "webhooks found for event" :total (count items))

5
backend/src/app/migrations/sql/0145-add-audit-log-telemetry-index.sql Normal file
View File

@ -0,0 +1,5 @@
-- Add index on audit_log (source, created_at) to support efficient
-- queries for the telemetry batch collection mode.
CREATE INDEX IF NOT EXISTS audit_log__source__created_at__idx
ON audit_log (source, created_at ASC);

8
backend/src/app/rpc.clj
View File

@ -109,6 +109,7 @@
(assoc ::handler-name handler-name)
(assoc ::ip-addr ip-addr)
(assoc ::request-at (ct/now))
(assoc ::request-id (uuid/next))
(assoc ::session-id (some-> session-id uuid/parse*))
(assoc ::cond/key etag)
(cond-> (uuid? profile-id)
@ -165,12 +166,13 @@
(defn- wrap-audit
[_ f mdata]
(if (or (contains? cf/flags :webhooks)
(contains? cf/flags :audit-log))
(contains? cf/flags :audit-log)
(contains? cf/flags :telemetry))
(if-not (::audit/skip mdata)
(fn [cfg params]
(let [result (f cfg params)]
(->> (audit/prepare-event cfg mdata params result)
(audit/submit! cfg))
(->> (audit/prepare-rpc-event cfg mdata params result)
(audit/submit cfg))
result))
f)
f))

125
backend/src/app/rpc/commands/audit.clj
View File

@ -15,7 +15,7 @@
[app.config :as cf]
[app.db :as db]
[app.http :as-alias http]
[app.loggers.audit :as-alias audit]
[app.loggers.audit :as audit]
[app.loggers.database :as loggers.db]
[app.loggers.mattermost :as loggers.mm]
[app.rpc :as-alias rpc]
@ -23,7 +23,8 @@
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.util.inet :as inet]
[app.util.services :as sv]))
[app.util.services :as sv]
[clojure.set :as set]))
(def ^:private event-columns
[:id
@ -38,31 +39,31 @@
:context])
(defn- event->row [event]
[(::audit/id event)
(::audit/name event)
(::audit/source event)
(::audit/type event)
(::audit/tracked-at event)
(::audit/created-at event)
(::audit/profile-id event)
(db/inet (::audit/ip-addr event))
(db/tjson (::audit/props event))
(db/tjson (d/without-nils (::audit/context event)))])
[(:id event)
(:name event)
(:source event)
(:type event)
(:tracked-at event)
(:created-at event)
(:profile-id event)
(db/inet (:ip-addr event))
(db/tjson (:props event))
(db/tjson (d/without-nils (:context event)))])
(defn- adjust-timestamp
[{:keys [::audit/tracked-at ::audit/created-at] :as event}]
[{:keys [tracked-at created-at] :as event}]
(let [margin (inst-ms (ct/diff tracked-at created-at))]
(if (or (neg? margin)
(> margin 3600000))
;; If event is in future or lags more than 1 hour, we reasign
;; tracked-at to the server creation date
(-> event
(assoc ::audit/tracked-at created-at)
(update ::audit/context assoc :original-tracked-at tracked-at))
(assoc :tracked-at created-at)
(update :context assoc :original-tracked-at tracked-at))
event)))
(defn- exception-event?
[{:keys [::audit/type ::audit/name] :as ev}]
[{:keys [type name] :as ev}]
(and (= "action" type)
(or (= "unhandled-exception" name)
(= "exception-page" name))))
@ -72,28 +73,41 @@
(map adjust-timestamp)
(map event->row)))
(defn- get-events
(defn- prepare-events
[{:keys [::rpc/request-at ::rpc/profile-id events] :as params}]
(let [request (-> params meta ::http/request)
ip-addr (inet/parse-request request)
xform (map (fn [event]
{::audit/id (uuid/next)
::audit/type (:type event)
::audit/name (:name event)
::audit/props (:props event)
::audit/context (:context event)
::audit/profile-id profile-id
::audit/ip-addr ip-addr
::audit/source "frontend"
::audit/tracked-at (:timestamp event)
::audit/created-at request-at}))]
{:id (uuid/next)
:type (:type event)
:name (:name event)
:props (:props event)
:context (:context event)
:profile-id profile-id
:ip-addr ip-addr
:source "frontend"
:tracked-at (:timestamp event)
:created-at request-at}))]
(sequence xform events)))
(def ^:private xf:map-telemetry-event-row
(comp
(map adjust-timestamp)
(map (fn [event]
(-> event
(assoc :id (uuid/next))
(update :created-at ct/truncate :days)
(update :tracked-at ct/truncate :days)
(audit/filter-telemetry-props)
(audit/filter-telemetry-context)
(assoc :ip-addr "0.0.0.0")
(assoc :source "telemetry:frontend"))))
(map event->row)))
(defn- handle-events
[{:keys [::db/pool] :as cfg} params]
(let [events (get-events params)]
(let [events (prepare-events params)]
;; Look for error reports and save them on internal reports table
(when-let [events (->> events
@ -102,9 +116,18 @@
(run! (partial loggers.db/emit cfg) events)
(run! (partial loggers.mm/emit cfg) events))
;; Process and save events
(when (seq events)
(let [rows (sequence xf:map-event-row events)]
(when (contains? cf/flags :audit-log)
;; Process and save full audit events when audit-log flag is active
(when-let [rows (-> (sequence xf:map-event-row events)
(not-empty))]
(db/insert-many! pool :audit-log event-columns rows)))
(when (contains? cf/flags :telemetry)
;; Store anonymized frontend events so the telemetry task can ship them
;; in batches. Runs independently from the audit-log insert above so
;; both modes can be active simultaneously.
(when-let [rows (-> (sequence xf:map-telemetry-event-row events)
(not-empty))]
(db/insert-many! pool :audit-log event-columns rows)))))
(def ^:private valid-event-types
@ -138,17 +161,31 @@
::doc/skip true
::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} params]
(if (or (db/read-only? pool)
(not (contains? cf/flags :audit-log)))
(do
(l/warn :hint "audit: http handler disabled or db is read-only")
(rph/wrap nil))
(let [telemetry? (contains? cf/flags :telemetry)
audit-log? (contains? cf/flags :audit-log)
enabled? (and (not (db/read-only? pool))
(or audit-log? telemetry?))]
(if-not enabled?
(do
(l/warn :hint "audit: http handler disabled or db is read-only")
(rph/wrap nil))
(do
(try
(handle-events cfg params)
(catch Throwable cause
(l/error :hint "unexpected error on persisting audit events from frontend"
:cause cause)))
(do
(try
(handle-events cfg params)
(catch Throwable cause
(l/error :hint "unexpected error on persisting audit events from frontend"
:cause cause)))
(rph/wrap nil))))
(rph/wrap nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GET-ENABLED-FLAGS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sv/defmethod ::get-enabled-flags
{::audit/skip true
::doc/skip true
::doc/added "1.20"}
[_cfg _params]
(set/intersection cf/flags #{:audit-log :telemetry}))

8
backend/src/app/rpc/commands/management.clj
View File

@ -439,10 +439,10 @@
(doseq [file-id result]
(let [props (assoc props :id file-id)
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/profile-id profile-id)
(assoc ::audit/name "create-file")
(assoc ::audit/props props))]
(audit/submit! cfg event))))))
(assoc :profile-id profile-id)
(assoc :name "create-file")
(assoc :props props))]
(audit/submit cfg event))))))
result))

12
backend/src/app/rpc/commands/teams_invitations.clj
View File

@ -205,9 +205,9 @@
organization "create-org-invitation"
:else "create-team-invitation")
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name evname)
(assoc ::audit/props props))]
(audit/submit! cfg event))
(assoc :name evname)
(assoc :props props))]
(audit/submit cfg event))
(when (allow-invitation-emails? member)
(if organization
@ -487,9 +487,9 @@
(let [props {:name name :features features}
event (-> (audit/event-from-rpc-params params)
(assoc ::audit/name "create-team")
(assoc ::audit/props props))]
(audit/submit! cfg event))
(assoc :name "create-team")
(assoc :props props))]
(audit/submit cfg event))
;; Create invitations for all provided emails.
(let [profile (db/get-by-id conn :profile profile-id)

24
backend/src/app/rpc/commands/verify_token.clj
View File

@ -223,24 +223,22 @@
:role (:role claims)
:invitation-id (:id invitation)}]
(audit/submit!
cfg
(-> (audit/event-from-rpc-params params)
(assoc ::audit/name "accept-team-invitation")
(assoc ::audit/props props)))
(audit/submit cfg
(-> (audit/event-from-rpc-params params)
(assoc :name "accept-team-invitation")
(assoc :props props)))
;; NOTE: Backward compatibility; old invitations can
;; have the `created-by` to be nil; so in this case we
;; don't submit this event to the audit-log
(when-let [created-by (:created-by invitation)]
(audit/submit!
cfg
(-> (audit/event-from-rpc-params params)
(assoc ::audit/profile-id created-by)
(assoc ::audit/name "accept-team-invitation-from")
(assoc ::audit/props (assoc props
:profile-id (:id profile)
:email (:email profile))))))
(audit/submit cfg
(-> (audit/event-from-rpc-params params)
(assoc :profile-id created-by)
(assoc :name "accept-team-invitation-from")
(assoc :props (assoc props
:profile-id (:id profile)
:email (:email profile))))))
(let [accepted-team-id (accept-invitation cfg claims invitation profile)]
(cond-> (assoc claims :state :created)

33
backend/src/app/setup.clj
View File

@ -11,7 +11,9 @@
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.loggers.audit :as audit]
[app.main :as-alias main]
[app.setup.keys :as keys]
[app.setup.templates]
@ -35,22 +37,20 @@
(into {})))
(defn- handle-instance-id
[instance-id conn read-only?]
[instance-id conn]
(or instance-id
(let [instance-id (uuid/random)]
(when-not read-only?
(try
(db/insert! conn :server-prop
{:id "instance-id"
:preload true
:content (db/tjson instance-id)})
(catch Throwable cause
(l/warn :hint "unable to persist instance-id"
:instance-id instance-id
:cause cause))))
(try
(db/insert! conn :server-prop
{:id "instance-id"
:preload true
:content (db/tjson instance-id)})
(catch Throwable cause
(l/warn :hint "unable to persist instance-id"
:instance-id instance-id
:cause cause)))
instance-id)))
(def sql:add-prop
"INSERT INTO server_prop (id, content, preload)
VALUES (?, ?, ?)
@ -77,7 +77,12 @@
(assert (db/pool? (::db/pool params)) "expected valid database pool"))
(defmethod ig/init-key ::props
[_ {:keys [::db/pool ::key] :as cfg}]
[_ {:keys [::key] :as cfg}]
(audit/submit cfg {:type "trigger"
:name "instance-start"
:props {:version (:full cf/version)
:flags (mapv name cf/flags)
:public-uri (str (cf/get :public-uri))}})
(db/tx-run! cfg (fn [{:keys [::db/conn]}]
(db/xact-lock! conn 0)
@ -91,7 +96,7 @@
(-> (get-all-props conn)
(assoc :secret-key secret)
(assoc :tokens-key (keys/derive secret :salt "tokens"))
(update :instance-id handle-instance-id conn (db/read-only? pool)))))))
(update :instance-id handle-instance-id conn))))))
(defmethod ig/init-key ::shared-keys
[_ {:keys [::props] :as cfg}]

131
backend/src/app/srepl/main.clj
View File

@ -553,14 +553,13 @@
(let [file-id (h/parse-uuid file-id)
tnow (ct/now)]
(audit/insert! main/system
{::audit/name "delete-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id file-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-file!"}
::audit/tracked-at tnow})
(audit/insert main/system
{:name "delete-file"
:type "action"
:props {:id file-id}
:context {:triggered-by "srepl"
:cause "explicit call to delete-file!"}
:tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :file
@ -578,15 +577,12 @@
{:id file-id}
{::db/remove-deleted false
::sql/columns [:id :name]})]
(audit/insert! system
{::audit/name "restore-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props file
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-file!"}
::audit/tracked-at (ct/now)})
(audit/insert system
{:name "restore-file"
:type "action"
:props file
:context {:triggered-by "srepl"
:cause "explicit call to restore-file!"}})
(#'files/restore-files conn [file-id]))
:restored))))
@ -597,14 +593,13 @@
(let [project-id (h/parse-uuid project-id)
tnow (ct/now)]
(audit/insert! main/system
{::audit/name "delete-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id project-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-project!"}
::audit/tracked-at tnow})
(audit/insert main/system
{:name "delete-project"
:type "action"
:props {:id project-id}
:context {:triggered-by "srepl"
:cause "explicit call to delete-project!"}
:tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
@ -635,14 +630,12 @@
(when-let [project (db/get* system :project
{:id project-id}
{::db/remove-deleted false})]
(audit/insert! system
{::audit/name "restore-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props project
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (ct/now)})
(audit/insert system
{:name "restore-project"
:type "action"
:props project
:context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}})
(restore-project* system project-id))))))
@ -652,14 +645,13 @@
(let [team-id (h/parse-uuid team-id)
tnow (ct/now)]
(audit/insert! main/system
{::audit/name "delete-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id team-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(audit/insert main/system
{:name "delete-team"
:type "action"
:props {:id team-id}
:context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
:tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
@ -695,14 +687,12 @@
{:id team-id}
{::db/remove-deleted false})
(teams/decode-row))]
(audit/insert! system
{::audit/name "restore-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props team
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (ct/now)})
(audit/insert system
{:name "restore-team"
:type "action"
:props team
:context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}})
(restore-team* system team-id))))))
@ -712,13 +702,12 @@
(let [profile-id (h/parse-uuid profile-id)
tnow (ct/now)]
(audit/insert! main/system
{::audit/name "delete-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(audit/insert main/system
{:name "delete-profile"
:type "action"
:context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
:tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
@ -737,14 +726,12 @@
{:id profile-id}
{::db/remove-deleted false})
(profile/decode-row))]
(audit/insert! system
{::audit/name "restore-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-profile!"}
::audit/tracked-at (ct/now)})
(audit/insert system
{:name "restore-profile"
:type "action"
:props (audit/profile->props profile)
:context {:triggered-by "srepl"
:cause "explicit call to restore-profile!"}})
(db/update! system :profile
{:deleted-at nil}
@ -768,14 +755,14 @@
{::db/remove-deleted false})
(profile/decode-row))]
(do
(audit/insert! system
{::audit/name "delete-profile"
::audit/type "action"
::audit/profile-id (:id profile)
::audit/tracked-at deleted-at
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profiles-in-bulk!"}})
(audit/insert system
{:name "delete-profile"
:type "action"
:profile-id (:id profile)
:tracked-at deleted-at
:props (audit/profile->props profile)
:context {:triggered-by "srepl"
:cause "explicit call to delete-profiles-in-bulk!"}})
(wrk/invoke! (-> system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile

232
backend/src/app/tasks/telemetry.clj
View File

@ -11,43 +11,27 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.config :as cf]
[app.db :as db]
[app.http.client :as http]
[app.main :as-alias main]
[app.setup :as-alias setup]
[app.util.blob :as blob]
[app.util.json :as json]
[integrant.core :as ig]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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]
(defn- get-subscriptions
[cfg]
(let [sql "SELECT email FROM profile where props->>'~:newsletter-updates' = 'true'"]
(->> (db/exec! conn [sql])
(mapv :email))))
(db/run! cfg (fn [{:keys [::db/conn]}]
(->> (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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LEGACY DATA COLLECTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- get-num-teams
[conn]
@ -161,8 +145,9 @@
(def ^:private sql:get-counters
"SELECT name, count(*) AS count
FROM audit_log
WHERE source = 'backend'
AND tracked_at >= date_trunc('day', now())
WHERE source LIKE 'telemetry:%'
AND created_at >= date_trunc('day', now())
AND created_at < date_trunc('day', now()) + interval '1 day'
GROUP BY 1
ORDER BY 2 DESC")
@ -174,23 +159,13 @@
{: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]
(defn- get-legacy-stats
[{:keys [::db/conn]}]
(let [referer (if (cf/get :telemetry-with-taiga)
"taiga"
(cf/get :telemetry-referer))]
(-> {:referer referer
:public-uri (cf/get :public-uri)
:public-uri (str (cf/get :public-uri))
:total-teams (get-num-teams conn)
:total-projects (get-num-projects conn)
:total-files (get-num-files conn)
@ -207,6 +182,124 @@
(get-action-counters conn))
(d/without-nils))))
(defn- make-legacy-request
[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 {:skip-ssrf-check? true})]
(when (> (:status response) 206)
(ex/raise :type :internal
:code :invalid-response
:response-status (:status response)
:response-body (:body response)))))
(defn- send-legacy-data
[{:keys [::setup/props] :as cfg} stats subs]
(let [data (cond-> {:type :telemetry-legacy-report
:version (:full cf/version)
:instance-id (:instance-id props)}
(some? stats)
(assoc :stats stats)
(seq subs)
(assoc :subscriptions subs))]
(make-legacy-request cfg data)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; AUDIT-EVENT BATCH (TELEMETRY MODE)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Telemetry events older than this are purged by the GC step so the
;; buffer stays bounded.
(def ^:private batch-size 10000)
(def ^:private sql:gc-events
"DELETE FROM audit_log
WHERE source LIKE 'telemetry:%'
AND created_at < now() - interval '7 days'")
(defn- gc-events
"Delete telemetry-mode events older than `telemetry-retention-days`
so that the buffer stays bounded."
[{:keys [::db/conn]}]
(let [result (db/exec-one! conn [sql:gc-events])]
(when (pos? (:next.jdbc/update-count result))
(l/warn :hint "purged stale telemetry events"
:count (:next.jdbc/update-count result)))))
(def ^:private sql:fetch-telemetry-events
"SELECT id, name, type, source, tracked_at, profile_id, props, context
FROM audit_log
WHERE source LIKE 'telemetry:%'
ORDER BY created_at ASC
LIMIT ?")
(defn- row->event
[{:keys [name type source tracked-at profile-id props context]}]
(d/without-nils
{:name name
:type type
:source source
:tracked-at tracked-at
:profile-id profile-id
:props (or (some-> props db/decode-transit-pgobject) {})
:context (or (some-> context db/decode-transit-pgobject) {})}))
(defn- encode-batch
"Encode a sequence of event maps into a fressian+zstd base64 string
suitable for JSON transport."
^String [events]
(blob/encode-str events {:version 4}))
(defn send-event-batch
"Send a single batch of events to the telemetry endpoint. Returns
true on success."
[{:keys [::setup/props] :as cfg} batch]
(let [payload {:type :telemetry-events
:version (:full cf/version)
:instance-id (:instance-id props)
:events (encode-batch batch)}
request {:method :post
:uri (cf/get :telemetry-uri)
:headers {"content-type" "application/json"}
:body (json/encode-str payload)}
resp (http/req cfg request {:skip-ssrf-check? true})]
(if (<= (:status resp) 206)
true
(do
(l/warn :hint "telemetry event batch send failed"
:status (:status resp)
:body (:body resp))
false))))
(defn- delete-sent-events
"Delete rows by their ids after a successful send."
[conn ids]
(let [arr (db/create-array conn "uuid" ids)]
(db/exec-one! conn ["DELETE FROM audit_log WHERE id = ANY(?)" arr])))
(defn- collect-and-send-audit-events
"Collect anonymous telemetry-mode audit events and ship them to the
telemetry endpoint in a loop. Each iteration fetches one page of
`batch-size` rows, encodes and sends them, then deletes the rows on
success. The loop stops as soon as a send fails, leaving remaining
rows intact for the next run."
[{:keys [::db/conn] :as cfg}]
(loop [counter 1]
(when-let [rows (-> (db/exec! conn [sql:fetch-telemetry-events batch-size])
(not-empty))]
(let [events (mapv row->event rows)
ids (mapv :id rows)]
(l/dbg :hint "shipping telemetry event batch"
:total (count events)
:batch counter)
(when (send-event-batch cfg events)
(delete-sent-events conn ids)
(recur (inc counter)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASK ENTRY POINT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -218,46 +311,45 @@
(assert (some? (::setup/props params)) "expected setup props to be available"))
(defmethod ig/init-key ::handler
[_ {:keys [::db/pool ::setup/props] :as cfg}]
[_ cfg]
(fn [task]
(let [params (:props task)
send? (get params :send? true)
enabled? (or (get params :enabled? false)
(contains? cf/flags :telemetry)
(cf/get :telemetry-enabled))
(contains? cf/flags :telemetry))
subs (get-subscriptions cfg)]
subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
:newsletter-news (get-subscriptions-newsletter-news pool)}
data {:subscriptions subs
:version (:full cf/version)
:instance-id (:instance-id props)}]
;; If we have telemetry enabled, then proceed the normal
;; operation sending legacy report
(when enabled?
(clean-counters-data! pool))
(if enabled?
(when send?
(db/run! cfg gc-events)
(px/sleep (rand-int 10000))
(cond
;; If we have telemetry enabled, then proceed the normal
;; operation.
enabled?
(let [data (merge data (get-stats pool))]
(when send?
(px/sleep (rand-int 10000))
(send! cfg data))
data)
(try
(let [stats (db/run! cfg get-legacy-stats)]
(send-legacy-data cfg stats subs))
(catch Exception cause
(l/wrn :hint "unable to send legacy report"
:cause cause)))
;; Ship any anonymous audit-log events accumulated in
;; telemetry mode (only when audit-log feature is off).
(when-not (contains? cf/flags :audit-log)
(try
(db/run! cfg collect-and-send-audit-events)
(catch Exception cause
(l/wrn :hint "unable to send events"
:cause cause)))))
;; If we have telemetry disabled, but there are users that are
;; explicitly checked the newsletter subscription on the
;; 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.
(or (seq (:newsletter-updates subs))
(seq (:newsletter-news subs)))
(do
(when send?
(px/sleep (rand-int 10000))
(send! cfg data))
data)
:else
data))))
(when (and send? (seq subs))
(px/sleep (rand-int 10000))
(ex/ignoring
(send-legacy-data cfg nil subs)))))))

13
backend/src/app/util/blob.clj
View File

@ -19,6 +19,7 @@
java.io.DataOutputStream
java.io.InputStream
java.io.OutputStream
java.util.Base64
net.jpountz.lz4.LZ4Compressor
net.jpountz.lz4.LZ4Factory
net.jpountz.lz4.LZ4FastDecompressor
@ -49,6 +50,13 @@
5 (encode-v5 data)
(throw (ex-info "unsupported version" {:version version}))))))
(defn encode-str
"Encode data to a blob and return it as a URL-safe base64 string
(no padding). Accepts the same options as `encode`."
(^String [data] (encode-str data nil))
(^String [data opts]
(.encodeToString (.withoutPadding (Base64/getUrlEncoder)) ^bytes (encode data opts))))
(defn decode
"A function used for decode persisted blobs in the database."
[^bytes data]
@ -63,6 +71,11 @@
5 (decode-v5 data)
(throw (ex-info "unsupported version" {:version version}))))))
(defn decode-str
"Decode a URL-safe base64 string produced by `encode-str` back to data."
[^String s]
(decode (.decode (Base64/getUrlDecoder) s)))
;; --- IMPL
(defn- encode-v1

2
backend/test/backend_tests/helpers.clj
View File

@ -83,7 +83,7 @@
[next]
(with-redefs [app.config/flags (flags/parse flags/default default-flags)
app.config/config config
app.loggers.audit/submit! (constantly nil)
app.loggers.audit/submit (constantly nil)
app.auth/derive-password identity
app.auth/verify-password (fn [a b] {:valid (= a b)})
app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)]

401
backend/test/backend_tests/rpc_audit_test.clj
View File

@ -9,7 +9,9 @@
[app.common.pprint :as pp]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.loggers.audit :as audit]
[app.rpc :as-alias rpc]
[backend-tests.helpers :as th]
[clojure.test :as t]
@ -96,4 +98,403 @@
(t/is (= "navigate" (:name row)))
(t/is (= "frontend" (:source row)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TELEMETRY MODE (frontend ingest)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest push-events-telemetry-mode-stores-anonymized-row
;; When telemetry is enabled and audit-log is NOT, frontend events
;; must be stored with source="telemetry", empty props, zeroed ip,
;; and context filtered to safe keys only.
(with-redefs [cf/flags #{:telemetry}]
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
params {::th/type :push-audit-events
::rpc/profile-id (:id prof)
:events [{:name "navigate"
:props {:project-id (str proj-id)
:team-id (str team-id)
:route "dashboard-files"}
:context {:browser "Chrome"
:browser-version "120.0"
:os "Linux"
:version "2.0.0"
:session "should-be-stripped"
:external-session-id "also-stripped"
:initiator "app"}
:timestamp (ct/now)
:type "action"}]}
params (with-meta params
{:app.http/request http-request})
out (th/command! params)]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
(let [[row :as rows] (->> (th/db-exec! ["select * from audit_log"])
(mapv decode-row))]
(t/is (= 1 (count rows)))
;; source is telemetry:frontend, not frontend
(t/is (= "telemetry:frontend" (:source row)))
;; profile-id preserved
(t/is (= (:id prof) (:profile-id row)))
;; event name preserved
(t/is (= "navigate" (:name row)))
;; navigate events keep route and team-id; other keys stripped
(t/is (= {:route "dashboard-files"
:team-id (str team-id)}
(:props row)))
;; ip zeroed
(t/is (= "0.0.0.0" (str (:ip-addr row))))
;; timestamps truncated to day precision
(let [day-now (ct/truncate (ct/now) :days)]
(t/is (= day-now (:created-at row)))
(t/is (= day-now (:tracked-at row))))
;; context only contains safe keys
(let [ctx (:context row)]
(t/is (contains? ctx :browser))
(t/is (= "Chrome" (:browser ctx)))
(t/is (contains? ctx :os))
(t/is (= "Linux" (:os ctx)))
;; session-linking keys stripped
(t/is (not (contains? ctx :session)))
(t/is (not (contains? ctx :external-session-id))))))))
(t/deftest push-events-both-flags-creates-two-rows
;; When both :audit-log and :telemetry flags are active, two rows
;; should be stored: one full audit entry and one telemetry entry.
(with-redefs [cf/flags #{:audit-log :telemetry}]
(let [prof (th/create-profile* 1 {:is-active true})
params {::th/type :push-audit-events
::rpc/profile-id (:id prof)
:events [{:name "navigate"
:props {:route "dashboard"}
:context {:browser "Chrome"
:version "2.0.0"
:initiator "app"}
:timestamp (ct/now)
:type "action"}]}
params (with-meta params
{:app.http/request http-request})
out (th/command! params)]
(t/is (nil? (:error out)))
(let [[row1 row2 :as rows] (->> (th/db-exec! ["select * from audit_log order by source"])
(mapv decode-row))]
(t/is (= 2 (count rows)))
;; First row: full audit-log entry
(t/is (= "frontend" (:source row1)))
(t/is (contains? (:props row1) :route))
(t/is (not= "0.0.0.0" (str (:ip-addr row1))))
;; Second row: telemetry entry
(t/is (= "telemetry:frontend" (:source row2)))
(t/is (= "0.0.0.0" (str (:ip-addr row2))))
(let [day-now (ct/truncate (ct/now) :days)]
(t/is (= day-now (:created-at row2)))
(t/is (= day-now (:tracked-at row2))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BACKEND PROCESS-EVENT PATH (RPC commands)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest backend-process-event-only-audit-log
(with-redefs [cf/flags #{:audit-log}]
(let [prof (th/create-profile* 1 {:is-active true})
event {:id (uuid/next)
:type "action"
:name "test-cmd"
:profile-id (:id prof)
:props {:full-key "full-val"}
:context {:version "2.0.0" :initiator "app"}
:tracked-at (ct/now)
:created-at (ct/now)
:source "backend"}]
(audit/submit* th/*system* event)
(let [[row :as rows] (->> (th/db-exec! ["select * from audit_log"])
(mapv decode-row))]
(t/is (= 1 (count rows)))
(t/is (= "backend" (:source row)))
(t/is (= "full-val" (get-in row [:props :full-key])))
(t/is (not= "0.0.0.0" (str (:ip-addr row))))))))
(t/deftest backend-process-event-only-telemetry
(with-redefs [cf/flags #{:telemetry}]
(let [prof (th/create-profile* 1 {:is-active true})
event {:id (uuid/next)
:type "action"
:name "test-cmd"
:profile-id (:id prof)
:props {:full-key "full-val"}
:context {:version "2.0.0" :initiator "app"}
:tracked-at (ct/now)
:created-at (ct/now)
:source "backend"}]
(audit/submit* th/*system* event)
(let [[row :as rows] (->> (th/db-exec! ["select * from audit_log"])
(mapv decode-row))]
(t/is (= 1 (count rows)))
(t/is (= "telemetry:backend" (:source row)))
(t/is (= "0.0.0.0" (str (:ip-addr row))))))))
(t/deftest backend-process-event-both-flags-creates-two-rows
;; When both :audit-log and :telemetry are active, the backend
;; process-event must store two rows: one full audit entry and one
;; telemetry entry.
(with-redefs [cf/flags #{:audit-log :telemetry}]
(let [prof (th/create-profile* 1 {:is-active true})
event {:id (uuid/next)
:type "action"
:name "test-cmd"
:profile-id (:id prof)
:props {:keep-me "important"}
:context {:version "2.0.0" :initiator "app"}
:tracked-at (ct/now)
:created-at (ct/now)
:source "backend"}]
(audit/submit* th/*system* event)
(let [[row1 row2 :as rows] (->> (th/db-exec! ["select * from audit_log order by source"])
(mapv decode-row))]
(t/is (= 2 (count rows)))
;; First row: full audit-log entry
(t/is (= "backend" (:source row1)))
(t/is (= "important" (get-in row1 [:props :keep-me])))
(t/is (not= "0.0.0.0" (str (:ip-addr row1))))
;; Second row: telemetry entry
(t/is (= "telemetry:backend" (:source row2)))
(t/is (= "0.0.0.0" (str (:ip-addr row2))))
(let [day-now (ct/truncate (ct/now) :days)]
(t/is (= day-now (:created-at row2)))
(t/is (= day-now (:tracked-at row2))))))))
(t/deftest push-events-disabled-when-no-flags-and-no-telemetry
;; When neither audit-log nor telemetry is enabled, no rows should
;; be stored.
(with-redefs [cf/flags #{}]
(let [prof (th/create-profile* 1 {:is-active true})
params {::th/type :push-audit-events
::rpc/profile-id (:id prof)
:events [{:name "navigate"
:props {:route "dashboard"}
:timestamp (ct/now)
:type "action"}]}
params (with-meta params
{:app.http/request http-request})
out (th/command! params)]
(t/is (nil? (:error out)))
(t/is (= 0 (count (th/db-exec! ["select * from audit_log"])))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PURE HELPER UNIT TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest extract-utm-params-utm
;; UTM params are namespaced under :penpot
(let [result (audit/extract-utm-params {:utm_source "google"
:utm_medium "cpc"
:utm_campaign "spring"
:other "ignored"})]
(t/is (= "google" (:penpot/utm-source result)))
(t/is (= "cpc" (:penpot/utm-medium result)))
(t/is (= "spring" (:penpot/utm-campaign result)))
(t/is (not (contains? result :other)))))
(t/deftest extract-utm-params-mtm
;; MTM params are also namespaced under :penpot
(let [result (audit/extract-utm-params {:mtm_source "newsletter"
:mtm_medium "email"})]
(t/is (= "newsletter" (:penpot/mtm-source result)))
(t/is (= "email" (:penpot/mtm-medium result)))))
(t/deftest extract-utm-params-empty
(t/is (= {} (audit/extract-utm-params {})))
(t/is (= {} (audit/extract-utm-params {:foo "bar" :baz 42}))))
(t/deftest profile->props-selects-and-merges
;; Selects profile-props keys and merges with (:props profile)
(let [profile {:id (uuid/next)
:fullname "John"
:email "john@example.com"
:is-active true
:lang "en"
:deleted-field "gone"
:props {:custom-key "custom-val"
:newsletter-updates true}}
result (audit/profile->props profile)]
;; Selected keys from profile
(t/is (= "John" (:fullname result)))
(t/is (= "john@example.com" (:email result)))
(t/is (true? (:is-active result)))
(t/is (= "en" (:lang result)))
;; Merged from (:props profile)
(t/is (= "custom-val" (:custom-key result)))
(t/is (true? (:newsletter-updates result)))
;; Keys not in profile-props are excluded
(t/is (not (contains? result :deleted-field)))))
(t/deftest profile->props-removes-nils
(let [profile {:id (uuid/next) :fullname nil :email "a@b.com"}
result (audit/profile->props profile)]
(t/is (not (contains? result :fullname)))
(t/is (= "a@b.com" (:email result)))))
(t/deftest clean-props-removes-reserved
;; Reserved props (:session-id, :password, :old-password, :token) are stripped
(let [props {:name "test"
:session-id "sess-123"
:password "secret"
:old-password "old-secret"
:token "tok-456"
:valid-key "kept"}
result (audit/clean-props props)]
(t/is (= "test" (:name result)))
(t/is (= "kept" (:valid-key result)))
(t/is (not (contains? result :session-id)))
(t/is (not (contains? result :password)))
(t/is (not (contains? result :old-password)))
(t/is (not (contains? result :token)))))
(t/deftest clean-props-removes-qualified-keys
;; Qualified keywords (namespaced) are stripped
(let [props {:simple "kept"
::namespaced "stripped"
:app.rpc/also-stripped true}
result (audit/clean-props props)]
(t/is (= "kept" (:simple result)))
(t/is (not (contains? result ::namespaced)))
(t/is (not (contains? result :app.rpc/also-stripped)))))
(t/deftest clean-props-removes-nils
(let [props {:a nil :b "val" :c nil}
result (audit/clean-props props)]
(t/is (= "val" (:b result)))
(t/is (not (contains? result :a)))
(t/is (not (contains? result :c)))))
(t/deftest get-external-session-id-valid
(let [request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-external-session-id" "abc-123")))]
(t/is (= "abc-123" (audit/get-external-session-id request)))))
(t/deftest get-external-session-id-nil-when-missing
(let [request (reify yetti.request/IRequest
(get-header [_ _] nil))]
(t/is (nil? (audit/get-external-session-id request)))))
(t/deftest get-external-session-id-nil-when-null-string
(let [request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-external-session-id" "null")))]
(t/is (nil? (audit/get-external-session-id request)))))
(t/deftest get-external-session-id-nil-when-blank
(let [request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-external-session-id" " ")))]
(t/is (nil? (audit/get-external-session-id request)))))
(t/deftest get-external-session-id-nil-when-too-long
(let [long-id (apply str (repeat 300 "x"))
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-external-session-id" long-id)))]
(t/is (nil? (audit/get-external-session-id request)))))
(t/deftest get-client-user-agent-valid
(let [request (reify yetti.request/IRequest
(get-header [_ name]
(case name "user-agent" "Mozilla/5.0 (Test)")))]
(t/is (= "Mozilla/5.0 (Test)" (audit/get-client-user-agent request)))))
(t/deftest get-client-user-agent-nil-when-missing
(let [request (reify yetti.request/IRequest
(get-header [_ _] nil))]
(t/is (nil? (audit/get-client-user-agent request)))))
(t/deftest get-client-user-agent-truncates-long
(let [long-ua (apply str (repeat 600 "x"))
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "user-agent" long-ua)))]
(t/is (<= (count (audit/get-client-user-agent request)) 500))))
(t/deftest get-client-event-origin-valid
(let [get-client-event-origin (ns-resolve 'app.loggers.audit 'get-client-event-origin)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-event-origin" "workspace")))]
(t/is (= "workspace" (get-client-event-origin request)))))
(t/deftest get-client-event-origin-nil-when-null
(let [get-client-event-origin (ns-resolve 'app.loggers.audit 'get-client-event-origin)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-event-origin" "null")))]
(t/is (nil? (get-client-event-origin request)))))
(t/deftest get-client-event-origin-nil-when-blank
(let [get-client-event-origin (ns-resolve 'app.loggers.audit 'get-client-event-origin)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-event-origin" " ")))]
(t/is (nil? (get-client-event-origin request)))))
(t/deftest get-client-event-origin-truncates-long
(let [get-client-event-origin (ns-resolve 'app.loggers.audit 'get-client-event-origin)
long-origin (apply str (repeat 300 "a"))
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-event-origin" long-origin)))]
(t/is (<= (count (get-client-event-origin request)) 200))))
(t/deftest get-client-version-valid
(let [get-client-version (ns-resolve 'app.loggers.audit 'get-client-version)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-frontend-version" "2.0.0")))]
(t/is (= "2.0.0" (get-client-version request)))))
(t/deftest get-client-version-nil-when-null
(let [get-client-version (ns-resolve 'app.loggers.audit 'get-client-version)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-frontend-version" "null")))]
(t/is (nil? (get-client-version request)))))
(t/deftest get-client-version-nil-when-blank
(let [get-client-version (ns-resolve 'app.loggers.audit 'get-client-version)
request (reify yetti.request/IRequest
(get-header [_ name]
(case name "x-frontend-version" " ")))]
(t/is (nil? (get-client-version request)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; INSERT DEFAULTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest insert-only-runs-with-audit-log-flag
;; insert must be a no-op when :audit-log flag is not set
(with-redefs [app.config/flags #{:telemetry}]
(audit/insert th/*system* {:name "test" :type "action"})
(t/is (= 0 (count (th/db-exec! ["select * from audit_log"]))))))
(t/deftest insert-sets-defaults
;; insert must set defaults and persist when :audit-log is set
(with-redefs [app.config/flags #{:audit-log}]
(audit/insert th/*system* {:name "test-action" :type "action"})
(let [[row] (->> (th/db-exec! ["select * from audit_log"])
(mapv decode-row))]
(t/is (some? row))
(t/is (= "test-action" (:name row)))
(t/is (= "action" (:type row)))
(t/is (= "backend" (:source row)))
(t/is (some? (:id row)))
(t/is (some? (:created-at row)))
(t/is (some? (:tracked-at row)))
(t/is (= {} (:props row)))
(t/is (= {} (:context row))))))

909
backend/test/backend_tests/tasks_telemetry_test.clj
View File

@ -6,42 +6,905 @@
(ns backend-tests.tasks-telemetry-test
(:require
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.loggers.audit :as audit]
[app.tasks.telemetry :as telemetry]
[app.util.blob :as blob]
[app.util.json :as json]
[backend-tests.helpers :as th]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]
[mockery.core :refer [with-mocks]]))
[mockery.core :refer [with-mocks]]
[promesa.exec :as px]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
;; Mock px/sleep for all tests to avoid 10s random delays.
;; Composed with database-reset so both apply.
(defn- test-fixture [next]
(th/database-reset
(fn []
(with-redefs [px/sleep (constantly nil)]
(next)))))
(t/use-fixtures :each test-fixture)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- insert-telemetry-row!
"Insert a single anonymised audit_log row as the telemetry mode does."
([name] (insert-telemetry-row! name {}))
([name {:keys [tracked-at created-at source]
:or {tracked-at (ct/now)
created-at (ct/now)
source "telemetry:backend"}}]
(th/db-insert! :audit-log
{:id (uuid/next)
:name name
:type "action"
:source source
:profile-id uuid/zero
:ip-addr (db/inet "0.0.0.0")
:props (db/tjson {})
:context (db/tjson {})
:tracked-at tracked-at
:created-at created-at})))
(defn- count-telemetry-rows []
(-> (th/db-exec-one! ["SELECT count(*) AS cnt FROM audit_log WHERE source IN ('telemetry:backend', 'telemetry:frontend')"])
:cnt
long))
(defn- decode-event-batch
"Decode the base64+fressian+zstd event-batch sent to the mock."
[b64-str]
(blob/decode-str b64-str))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; STATS / REPORT STRUCTURE TESTS (existing behaviour, extended)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-base-report-data-structure
(with-mocks [mock {:target 'app.tasks.telemetry/send!
(with-mocks [mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(let [prof (th/create-profile* 1 {:is-active true
:props {:newsletter-news true}})]
:props {:newsletter-updates true}})]
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (:called? @mock))
(let [[_ data] (-> @mock :call-args)]
(t/is (= :telemetry-legacy-report (:type data)))
(t/is (contains? data :subscriptions))
(t/is (= [(:email prof)] (get-in data [:subscriptions :newsletter-news])))
(t/is (contains? data :total-fonts))
(t/is (contains? data :total-users))
(t/is (contains? data :total-projects))
(t/is (contains? data :total-files))
(t/is (contains? data :total-teams))
(t/is (contains? data :total-comments))
(t/is (contains? data :instance-id))
(t/is (contains? data :jvm-cpus))
(t/is (contains? data :jvm-heap-max))
(t/is (contains? data :max-users-on-team))
(t/is (contains? data :avg-users-on-team))
(t/is (contains? data :max-files-on-project))
(t/is (contains? data :avg-files-on-project))
(t/is (contains? data :max-projects-on-team))
(t/is (contains? data :avg-files-on-project))
(t/is (= [(:email prof)] (:subscriptions data)))
(t/is (contains? data :stats))
(let [stats (:stats data)]
(t/is (contains? stats :total-fonts))
(t/is (contains? stats :total-users))
(t/is (contains? stats :total-projects))
(t/is (contains? stats :total-files))
(t/is (contains? stats :total-teams))
(t/is (contains? stats :total-comments))
(t/is (contains? stats :jvm-cpus))
(t/is (contains? stats :jvm-heap-max))
(t/is (contains? stats :max-users-on-team))
(t/is (contains? stats :avg-users-on-team))
(t/is (contains? stats :max-files-on-project))
(t/is (contains? stats :avg-files-on-project))
(t/is (contains? stats :max-projects-on-team))
(t/is (contains? stats :avg-files-on-project))
(t/is (contains? stats :email-domains))
(t/is (= ["nodomain.com"] (:email-domains stats)))
;; public-uri must be a string
(t/is (string? (:public-uri stats)))
(t/is (not-empty (:public-uri stats))))
(t/is (contains? data :version))
(t/is (contains? data :email-domains))
(t/is (= ["nodomain.com"] (:email-domains data)))))))
(t/is (contains? data :instance-id))))))
(t/deftest test-telemetry-disabled-no-send
;; When telemetry is disabled and no newsletter subscriptions exist,
;; make-legacy-request must not be called at all.
(with-mocks [mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{}]
(th/create-profile* 1 {:is-active true})
(th/run-task! :telemetry {:send? true})
(t/is (not (:called? @mock))))))
(t/deftest test-telemetry-disabled-newsletter-only-send
;; When telemetry is disabled but a user has newsletter-updates opted in,
;; make-legacy-request is called once with only subscriptions + version (no stats).
(with-mocks [mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{}]
(let [prof (th/create-profile* 1 {:is-active true
:props {:newsletter-updates true}})]
(th/run-task! :telemetry {:send? true})
(t/is (:called? @mock))
(let [[_ data] (:call-args @mock)]
;; Limited payload — no stats
(t/is (contains? data :subscriptions))
(t/is (contains? data :version))
(t/is (not (contains? data :stats)))
(t/is (= [(:email prof)] (:subscriptions data))))))))
(t/deftest test-send-is-skipped-when-send?-false
;; Passing send?=false must suppress all HTTP calls even when enabled.
(with-mocks [mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}]
(th/create-profile* 1 {:is-active true})
(th/run-task! :telemetry {:send? false :enabled? true})
(t/is (not (:called? @mock))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; AUDIT-EVENT BATCH COLLECTION TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-no-audit-events-no-batch-call
;; When telemetry is enabled but there are no audit_log rows with
;; source='telemetry', the batch send path must not be invoked.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return true}]
(with-redefs [cf/flags #{:telemetry}]
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (:called? @legacy-mock))
(t/is (not (:called? @batch-mock))))))
(t/deftest test-audit-events-sent-and-deleted-on-success
;; Happy path: telemetry rows are collected, shipped as a batch and
;; deleted from the table when the endpoint returns success.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return true}]
(with-redefs [cf/flags #{:telemetry}]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(insert-telemetry-row! "update-file")
(t/is (= 3 (count-telemetry-rows)))
(th/run-task! :telemetry {:send? true :enabled? true})
;; batch send was called at least once
(t/is (:called? @batch-mock))
;; all rows deleted after successful send
(t/is (= 0 (count-telemetry-rows))))))
(t/deftest test-audit-events-kept-on-batch-failure
;; When the batch endpoint returns failure the rows must be retained
;; so the next scheduled run can retry.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return false}]
(with-redefs [cf/flags #{:telemetry}]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (:called? @batch-mock))
;; rows still present — not deleted on failure
(t/is (= 2 (count-telemetry-rows))))))
(t/deftest test-audit-events-not-collected-when-audit-log-flag-set
;; When the :audit-log flag is active, mode C is disabled and the
;; batch path must never run (audit-log owns those rows instead).
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return true}]
(with-redefs [cf/flags #{:telemetry :audit-log}]
(insert-telemetry-row! "navigate")
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (not (:called? @batch-mock)))
;; row untouched
(t/is (= 1 (count-telemetry-rows))))))
(t/deftest test-batch-payload-contains-required-fields
;; Inspect the actual arguments forwarded to send-event-batch to
;; verify the payload carries instance-id, version and events.
(let [captured (atom nil)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/send-event-batch
(fn [_cfg batch]
(reset! captured batch)
true)]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (some? @captured))
(let [batch @captured]
;; batch is a seq of event maps
(t/is (seq batch))
(t/is (= 2 (count batch)))
;; each event has name, type, source — profile-id is preserved,
;; props and ip-addr are stripped
(let [ev (first batch)]
(t/is (contains? ev :name))
(t/is (contains? ev :type))
(t/is (contains? ev :source))
(t/is (contains? ev :profile-id))
;; props are present but empty (stripped at ingest time)
(t/is (= {} (:props ev)))
(t/is (not (contains? ev :ip-addr)))))))))
(t/deftest test-batch-encoding-is-decodable
;; Verify that encode-batch produces a blob that round-trips back
;; through blob/decode to the original data.
(let [events [{:name "navigate" :type "action" :source "telemetry"
:tracked-at (ct/now)}
{:name "create-file" :type "action" :source "telemetry"
:tracked-at (ct/now)}]
;; Call the private fn through the ns-mapped var
encode (ns-resolve 'app.tasks.telemetry 'encode-batch)
encoded (encode events)
decoded (decode-event-batch encoded)]
(t/is (string? encoded))
(t/is (seq decoded))
(t/is (= (count events) (count decoded)))
(t/is (= "navigate" (:name (first decoded))))
(t/is (= "create-file" (:name (second decoded))))))
(t/deftest test-multiple-batches-when-many-events
;; Lower batch-size to 1 so that 3 events produce 3 separate
;; HTTP requests and verify all are sent and all rows deleted.
(let [call-count (atom 0)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/batch-size 1
telemetry/send-event-batch
(fn [_cfg _batch]
(swap! call-count inc)
true)]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(insert-telemetry-row! "update-file")
(th/run-task! :telemetry {:send? true :enabled? true})
;; Each event is fetched and sent in its own loop iteration
(t/is (= 3 @call-count))
;; All rows deleted after all iterations succeed
(t/is (= 0 (count-telemetry-rows)))))))
(t/deftest test-partial-failure-stops-remaining-batches
;; With batch-size 1, when the second send fails the loop stops.
;; The first batch was already deleted; the two remaining rows
;; are retained for the next run.
(let [call-count (atom 0)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/batch-size 1
telemetry/send-event-batch
(fn [_cfg _batch]
(swap! call-count inc)
;; fail on the second call
(not= 2 @call-count))]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(insert-telemetry-row! "update-file")
(th/run-task! :telemetry {:send? true :enabled? true})
;; Stopped at iteration 2 — third event never attempted
(t/is (= 2 @call-count))
;; First batch was deleted on success; 2 rows remain for retry
(t/is (= 2 (count-telemetry-rows)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GC / RETENTION-WINDOW TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-gc-purges-events-older-than-7-days
;; Insert events from 8 days ago (stale) and from today (fresh).
;; After the task runs, stale events must be purged by GC and fresh
;; ones shipped by the batch sender.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return true}]
(with-redefs [cf/flags #{:telemetry}]
(let [now (ct/now)
eight-days (ct/minus now (ct/duration {:days 8}))]
;; Stale events (older than 7 days)
(insert-telemetry-row! "stale-1" {:created-at eight-days :tracked-at eight-days})
(insert-telemetry-row! "stale-2" {:created-at eight-days :tracked-at eight-days})
;; Fresh events (today)
(insert-telemetry-row! "fresh-1" {:created-at now :tracked-at now})
(insert-telemetry-row! "fresh-2" {:created-at now :tracked-at now})
(t/is (= 4 (count-telemetry-rows)))
(th/run-task! :telemetry {:send? true :enabled? true})
;; GC purged the 2 stale rows, batch sender shipped the 2 fresh ones
(t/is (= 0 (count-telemetry-rows)))))))
(t/deftest test-gc-keeps-events-within-7-day-window
;; When all events are within the 7-day window, GC must not delete
;; anything and all rows are forwarded to the batch sender.
(let [batch-events (atom nil)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/send-event-batch
(fn [_cfg batch]
(reset! batch-events batch)
true)]
(let [six-days-ago (ct/minus (ct/now) (ct/duration {:days 6}))]
(insert-telemetry-row! "recent-1" {:created-at six-days-ago :tracked-at six-days-ago})
(insert-telemetry-row! "recent-2" {:created-at six-days-ago :tracked-at six-days-ago}))
(th/run-task! :telemetry {:send? true :enabled? true})
;; Both events forwarded — GC left them alone
(t/is (= 2 (count @batch-events)))
(t/is (= 0 (count-telemetry-rows)))))))
(t/deftest test-gc-deletes-only-stale-events
;; Insert a mix of stale (8 days old) and fresh (1 day old) events.
;; After GC, only fresh events should remain for the batch sender.
(let [batch-events (atom nil)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/send-event-batch
(fn [_cfg batch]
(reset! batch-events batch)
true)]
(let [eight-days (ct/minus (ct/now) (ct/duration {:days 8}))
one-day (ct/minus (ct/now) (ct/duration {:days 1}))]
(insert-telemetry-row! "stale" {:created-at eight-days :tracked-at eight-days})
(insert-telemetry-row! "fresh" {:created-at one-day :tracked-at one-day}))
(t/is (= 2 (count-telemetry-rows)))
(th/run-task! :telemetry {:send? true :enabled? true})
;; GC purged stale, batch shipped fresh
(t/is (= 1 (count @batch-events)))
(t/is (= "fresh" (:name (first @batch-events))))
(t/is (= 0 (count-telemetry-rows)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ANONYMITY TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-telemetry-rows-stored-without-pii
;; Rows written to audit_log in telemetry mode must carry no PII:
;; empty props, zeroed ip, profile-id=zero, source='telemetry'.
;; Safe context fields (browser, os, version, etc.) are preserved
;; but session-linking and access-token fields are stripped.
(with-redefs [cf/flags #{:telemetry}]
(let [_prof (th/create-profile* 1 {:is-active true})
safe-ctx {:browser "Chrome"
:browser-version "120.0"
:os "Linux"
:version "2.0.0"}]
;; Simulate what app.loggers.audit/process-event does in mode C
(th/db-insert! :audit-log
{:id (uuid/next)
:name "create-project"
:type "action"
:source "telemetry:backend"
:profile-id uuid/zero
:ip-addr (db/inet "0.0.0.0")
:props (db/tjson {})
:context (db/tjson safe-ctx)
:tracked-at (ct/now)
:created-at (ct/now)})
(let [[row] (th/db-exec! ["SELECT * FROM audit_log WHERE source = 'telemetry:backend'"])]
(t/is (= "telemetry:backend" (:source row)))
;; props are always empty
(t/is (= "{}" (str (:props row))))
;; ip_addr is the sentinel zero address
(t/is (= "0.0.0.0" (str (:ip-addr row))))
;; profile-id is uuid/zero — not a real user id
(t/is (= uuid/zero (:profile-id row)))))))
(t/deftest test-batch-events-contain-no-pii-fields
;; The event maps forwarded to send-event-batch must not carry props,
;; ip-addr or profile-id. Safe context fields (browser, os, etc.) may
;; be present but session-linking keys must be absent.
(let [captured-batch (atom nil)
;; Insert a row that carries safe context (as the real path does)
safe-ctx {:browser "Firefox" :browser-version "121.0"
:os "macOS" :session "should-be-stripped"
:external-session-id "also-stripped"}]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/send-event-batch
(fn [_cfg batch]
(reset! captured-batch batch)
true)]
;; Insert with safe context already pre-filtered (as the ingest path does)
(th/db-insert! :audit-log
{:id (uuid/next)
:name "navigate"
:type "action"
:source "telemetry:frontend"
:profile-id uuid/zero
:ip-addr (db/inet "0.0.0.0")
:props (db/tjson {})
:context (db/tjson (dissoc safe-ctx :session :external-session-id))
:tracked-at (ct/now)
:created-at (ct/now)})
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (= 1 (count @captured-batch)))
(let [ev (first @captured-batch)]
;; must have the core identity fields including profile-id
(t/is (contains? ev :name))
(t/is (contains? ev :type))
(t/is (contains? ev :source))
(t/is (contains? ev :tracked-at))
(t/is (contains? ev :profile-id))
;; props are present but empty (stripped at ingest time)
(t/is (= {} (:props ev)))
;; ip-addr is stripped
(t/is (not (contains? ev :ip-addr)))
;; context may be present and must not contain session-linking keys
(when-let [ctx (:context ev)]
(t/is (not (contains? ctx :session)))
(t/is (not (contains? ctx :external-session-id)))
;; safe keys should be present
(t/is (contains? ctx :browser))))))))
(t/deftest test-telemetry-rows-have-day-precision-timestamps
;; Telemetry events must be stored with timestamps truncated to day
;; precision so that exact event timing cannot be inferred.
(with-redefs [cf/flags #{:telemetry}]
(let [process-event (ns-resolve 'app.loggers.audit 'process-event)
profile (th/create-profile* 1 {:is-active true})
tnow (ct/now)
event {:type "action"
:name "create-project"
:profile-id (:id profile)
:source "backend"
:props {}
:context {}
:created-at tnow
:tracked-at tnow
:ip-addr "0.0.0.0"}]
(db/tx-run! th/*system* process-event event)
(let [[row] (th/db-exec! ["SELECT * FROM audit_log WHERE source = 'telemetry:backend'"])]
(t/is (some? row))
(let [created-at (:created-at row)
tracked-at (:tracked-at row)
day-now (ct/truncate (ct/now) :days)]
;; Both timestamps must equal midnight of the current day
(t/is (= day-now created-at))
(t/is (= day-now tracked-at)))))))
(t/deftest test-backend-ingest-full-row-shape
;; Verify the full row shape stored by process-event in telemetry mode:
;; source=telemetry:backend, empty props, zeroed ip, context filtered to safe
;; backend keys only, profile-id preserved, timestamps truncated.
(with-redefs [cf/flags #{:telemetry}]
(let [process-event (ns-resolve 'app.loggers.audit 'process-event)
profile (th/create-profile* 1 {:is-active true})
tnow (ct/now)
event {:type "action"
:name "create-project"
:profile-id (:id profile)
:source "backend"
:context {:initiator "app"
:version "2.0.0"
:client-version "1.0"
:client-user-agent "Mozilla/5.0"
:external-session-id "should-be-stripped"
:session "also-stripped"}
:props {:some-prop "value"}
:created-at tnow
:tracked-at tnow
:ip-addr "0.0.0.0"}]
(db/tx-run! th/*system* process-event event)
(let [[row] (th/db-exec! ["SELECT * FROM audit_log WHERE source = 'telemetry:backend'"])]
(t/is (some? row))
;; source
(t/is (= "telemetry:backend" (:source row)))
;; profile-id preserved
(t/is (= (:id profile) (:profile-id row)))
;; name
(t/is (= "create-project" (:name row)))
;; type
(t/is (= "action" (:type row)))
;; props stripped to empty
(t/is (= "{}" (str (:props row))))
;; ip zeroed
(t/is (= "0.0.0.0" (str (:ip-addr row))))
;; timestamps truncated to day
(let [day-now (ct/truncate (ct/now) :days)]
(t/is (= day-now (:created-at row)))
(t/is (= day-now (:tracked-at row))))
;; context filtered: only safe backend keys retained
(let [ctx (db/decode-transit-pgobject (:context row))]
(t/is (= "app" (:initiator ctx)))
(t/is (= "2.0.0" (:version ctx)))
(t/is (= "1.0" (:client-version ctx)))
(t/is (= "Mozilla/5.0" (:client-user-agent ctx)))
;; session-linking keys stripped
(t/is (not (contains? ctx :external-session-id)))
(t/is (not (contains? ctx :session))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILTER-TELEMETRY-CONTEXT UNIT TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-filter-telemetry-context-keeps-browser-fields
;; Safe environment fields must survive the filter.
(let [filter-telemetry-context (ns-resolve 'app.loggers.audit 'filter-telemetry-context)
ctx {:browser "Chrome"
:browser-version "120.0"
:engine "Blink"
:engine-version "120.0"
:os "Windows 11"
:os-version "11"
:device-type "unknown"
:device-arch "amd64"
:locale "en-US"
:version "2.0.0"
:screen-width 1920
:screen-height 1080
:event-origin "workspace"}
result (:context (filter-telemetry-context {:source "frontend" :context ctx}))]
(t/is (= "Chrome" (:browser result)))
(t/is (= "120.0" (:browser-version result)))
(t/is (= "Windows 11" (:os result)))
(t/is (= "en-US" (:locale result)))
(t/is (= "workspace" (:event-origin result)))
(t/is (= 1920 (:screen-width result)))))
(t/deftest test-filter-telemetry-context-strips-pii-keys
;; Session-linking and access-token fields must be removed.
(let [filter-telemetry-context (ns-resolve 'app.loggers.audit 'filter-telemetry-context)
ctx {:browser "Firefox"
:session "abc-session-id"
:external-session-id "ext-123"
:file-stats {:total-shapes 42}
:initiator "app"
:access-token-id "tok-456"
:access-token-type "api-key"}
result (:context (filter-telemetry-context {:source "frontend" :context ctx}))]
(t/is (= "Firefox" (:browser result)))
(t/is (not (contains? result :session)))
(t/is (not (contains? result :external-session-id)))
(t/is (not (contains? result :file-stats)))
(t/is (not (contains? result :initiator)))
(t/is (not (contains? result :access-token-id)))
(t/is (not (contains? result :access-token-type)))))
(t/deftest test-filter-telemetry-context-empty-input
;; An empty context should return an empty map without error.
(let [filter-telemetry-context (ns-resolve 'app.loggers.audit 'filter-telemetry-context)]
(t/is (= {} (:context (filter-telemetry-context {:source "frontend" :context {}}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILTER-TELEMETRY-PROPS UNIT TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-filter-telemetry-props-login-event-keeps-safe-profile-fields
;; Login/register/update events carry safe profile-derived fields:
;; :lang, :auth-backend, :email-domain. Raw :email is stripped.
(let [ftp (ns-resolve 'app.loggers.audit 'filter-telemetry-props)]
;; backend login-with-password
(let [result (ftp {:source "backend"
:name "login-with-password"
:type "action"
:props {:email "user@example.com"
:fullname "John Doe"
:lang "en"
:auth-backend "password"
:id (uuid/next)}})]
(t/is (= "en" (get-in result [:props :lang])))
(t/is (= "password" (get-in result [:props :auth-backend])))
(t/is (= "example.com" (get-in result [:props :email-domain])))
;; Raw email and fullname are stripped
(t/is (not (contains? (:props result) :email)))
(t/is (not (contains? (:props result) :fullname)))
;; UUID values survive the xf:filter-telemetry-props filter
(t/is (some? (get-in result [:props :id]))))
;; backend register-profile
(let [result (ftp {:source "backend"
:name "register-profile"
:type "action"
:props {:email "new@corp.org"
:lang "es"
:auth-backend "oidc"}})]
(t/is (= "es" (get-in result [:props :lang])))
(t/is (= "oidc" (get-in result [:props :auth-backend])))
(t/is (= "corp.org" (get-in result [:props :email-domain]))))
;; backend login-with-oidc
(let [result (ftp {:source "backend"
:name "login-with-oidc"
:type "action"
:props {:email "u@corp.io" :lang "fr" :auth-backend "oidc"}})]
(t/is (= "fr" (get-in result [:props :lang])))
(t/is (= "oidc" (get-in result [:props :auth-backend])))
(t/is (= "corp.io" (get-in result [:props :email-domain]))))
;; backend update-profile
(let [result (ftp {:source "backend"
:name "update-profile"
:type "action"
:props {:email "u@corp.io" :lang "de"}})]
(t/is (= "de" (get-in result [:props :lang])))
(t/is (= "corp.io" (get-in result [:props :email-domain]))))))
(t/deftest test-filter-telemetry-props-frontend-identify-keeps-safe-profile-fields
;; Frontend identify events also carry safe profile-derived fields.
(let [ftp (ns-resolve 'app.loggers.audit 'filter-telemetry-props)]
(let [result (ftp {:source "frontend"
:name "signin"
:type "identify"
:props {:email "user@example.com"
:fullname "Jane Doe"
:lang "pt"
:auth-backend "password"
:some-string "should-be-stripped"}})]
(t/is (= "pt" (get-in result [:props :lang])))
(t/is (= "password" (get-in result [:props :auth-backend])))
(t/is (= "example.com" (get-in result [:props :email-domain])))
;; PII stripped
(t/is (not (contains? (:props result) :email)))
(t/is (not (contains? (:props result) :fullname)))
;; String values that are not UUID/boolean/number are stripped
(t/is (not (contains? (:props result) :some-string))))))
(t/deftest test-filter-telemetry-props-instance-start-passthrough
;; instance-start trigger events pass through as-is.
(let [ftp (ns-resolve 'app.loggers.audit 'filter-telemetry-props)
props {:total-teams 5 :total-users 42 :version "2.0"}
result (ftp {:source "backend"
:name "instance-start"
:type "trigger"
:props props})]
(t/is (= props (:props result)))))
(t/deftest test-filter-telemetry-props-generic-event-keeps-uuid-boolean-number
;; Generic events (create-file, etc.) keep only entries
;; whose values are UUIDs, booleans, or numbers.
(let [ftp (ns-resolve 'app.loggers.audit 'filter-telemetry-props)
id (uuid/next)
result (ftp {:source "frontend"
:name "create-file"
:type "action"
:props {:project-id id
:team-id id
:route "dashboard-files"
:count 42
:active true
:label "should-be-stripped"}})]
;; UUIDs survive
(t/is (= id (get-in result [:props :project-id])))
(t/is (= id (get-in result [:props :team-id])))
;; Numbers survive
(t/is (= 42 (get-in result [:props :count])))
;; Booleans survive
(t/is (true? (get-in result [:props :active])))
;; Strings are stripped
(t/is (not (contains? (:props result) :route)))
(t/is (not (contains? (:props result) :label)))))
(t/deftest test-filter-telemetry-props-navigate-keeps-route-and-ids
;; Frontend navigate events keep specific routing keys: :route,
;; :file-id, :team-id, :page-id. These ids are strings because
;; routing events don't coerce them. All other props are stripped.
(let [ftp (ns-resolve 'app.loggers.audit 'filter-telemetry-props)
file-id (str (uuid/next))
team-id (str (uuid/next))
page-id (str (uuid/next))
result (ftp {:source "frontend"
:name "navigate"
:type "action"
:props {:file-id file-id
:team-id team-id
:page-id page-id
:route "dashboard-index"
:session "abc"
:count 42
:active true
:label "should-be-stripped"}})]
;; Allowed routing keys survive (as strings, not coerced to UUID)
(t/is (= file-id (get-in result [:props :file-id])))
(t/is (= team-id (get-in result [:props :team-id])))
(t/is (= page-id (get-in result [:props :page-id])))
(t/is (= "dashboard-index" (get-in result [:props :route])))
;; Everything else is stripped
(t/is (not (contains? (:props result) :session)))
(t/is (not (contains? (:props result) :count)))
(t/is (not (contains? (:props result) :active)))
(t/is (not (contains? (:props result) :label)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SEND-EVENT-BATCH PAYLOAD STRUCTURE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-send-event-batch-payload-structure
;; Verify the HTTP request sent by send-event-batch carries the
;; correct outer wrapper: :type, :version, :instance-id, :events.
(let [captured-request (atom nil)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
http-mock {:target 'app.http.client/req
:return {:status 200}}]
(with-redefs [cf/flags #{:telemetry}]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(th/run-task! :telemetry {:send? true :enabled? true})
;; http/req was called (by both send-legacy-data and send-event-batch)
(t/is (:called? @http-mock))
;; Find the call whose body contains :telemetry-events
(let [calls (filter (fn [args]
(let [[_ request] args
body (:body request)]
(and (string? body)
(re-find #"telemetry-events" body))))
(:call-args-list @http-mock))]
(t/is (= 1 (count calls)))
(let [[_ request] (first calls)
body (json/decode (:body request))]
;; Outer payload fields
(t/is (= "telemetry-events" (name (:type body))))
(t/is (string? (:version body)))
(t/is (some? (:instance-id body)))
;; :events is a base64-encoded blob
(t/is (string? (:events body)))
(t/is (pos? (count (:events body))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASK BRANCH COVERAGE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-enabled-no-subs-no-events-legacy-still-sends
;; When telemetry is enabled, there are no newsletter subscriptions
;; and no audit_log rows, the legacy report must still be sent.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return true}]
(with-redefs [cf/flags #{:telemetry}]
;; No profiles with newsletter-updates, no telemetry rows
(th/run-task! :telemetry {:send? true :enabled? true})
;; Legacy report was sent
(t/is (:called? @legacy-mock))
(let [[_ data] (:call-args @legacy-mock)]
(t/is (= :telemetry-legacy-report (:type data)))
(t/is (contains? data :stats))
;; No subscriptions in the payload
(t/is (not (contains? data :subscriptions))))
;; No events to batch-send
(t/is (not (:called? @batch-mock))))))
(t/deftest test-legacy-succeeds-batch-fails
;; The legacy report and event batch are independent paths.
;; When the batch endpoint fails, the legacy report must still
;; have been sent successfully.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return false}]
(with-redefs [cf/flags #{:telemetry}]
(insert-telemetry-row! "navigate")
(th/run-task! :telemetry {:send? true :enabled? true})
;; Legacy report was sent
(t/is (:called? @legacy-mock))
(let [[_ data] (:call-args @legacy-mock)]
(t/is (= :telemetry-legacy-report (:type data))))
;; Batch send was attempted but failed
(t/is (:called? @batch-mock))
;; Row still present (not deleted on failure)
(t/is (= 1 (count-telemetry-rows))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GC + BATCH FAILURE INTERACTION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-gc-runs-even-when-batch-fails
;; GC must purge stale events regardless of whether the subsequent
;; batch send succeeds or fails.
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}
batch-mock {:target 'app.tasks.telemetry/send-event-batch
:return false}]
(with-redefs [cf/flags #{:telemetry}]
(let [eight-days (ct/minus (ct/now) (ct/duration {:days 8}))
one-day (ct/minus (ct/now) (ct/duration {:days 1}))]
;; Stale events (should be GC'd)
(insert-telemetry-row! "stale-1" {:created-at eight-days :tracked-at eight-days})
(insert-telemetry-row! "stale-2" {:created-at eight-days :tracked-at eight-days})
;; Fresh event (should survive GC but fail to send)
(insert-telemetry-row! "fresh" {:created-at one-day :tracked-at one-day})
(t/is (= 3 (count-telemetry-rows)))
(th/run-task! :telemetry {:send? true :enabled? true})
;; Batch send was attempted (and failed)
(t/is (:called? @batch-mock))
;; Stale rows were purged by GC, fresh row remains
(t/is (= 1 (count-telemetry-rows)))
(t/is (= "fresh" (:name (first (th/db-exec! ["SELECT name FROM audit_log WHERE source LIKE 'telemetry:%'"])))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ROW->EVENT CONTEXT GUARANTEE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-row->event-always-includes-context
;; row->event must always include :context as a map, even when the
;; DB column contains an empty transit object.
(let [row->event (ns-resolve 'app.tasks.telemetry 'row->event)]
;; With non-empty context
(let [ev (row->event {:name "test" :type "action" :source "telemetry:backend"
:tracked-at (ct/now) :profile-id uuid/zero
:context (db/tjson {:browser "Chrome"})})]
(t/is (contains? ev :context))
(t/is (= {:browser "Chrome"} (:context ev))))
;; With empty context ({} in transit)
(let [ev (row->event {:name "test" :type "action" :source "telemetry:backend"
:tracked-at (ct/now) :profile-id uuid/zero
:context (db/tjson {})})]
(t/is (contains? ev :context))
(t/is (= {} (:context ev))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NO DUPLICATE EVENTS ON SUCCESS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest test-no-duplicate-events-after-successful-send
;; After a successful batch send, the sent rows must be deleted.
;; Running the task again must NOT re-send the same events.
(let [send-count (atom 0)]
(with-mocks [legacy-mock {:target 'app.tasks.telemetry/make-legacy-request
:return nil}]
(with-redefs [cf/flags #{:telemetry}
telemetry/send-event-batch
(fn [_cfg _batch]
(swap! send-count inc)
true)]
(insert-telemetry-row! "navigate")
(insert-telemetry-row! "create-file")
(t/is (= 2 (count-telemetry-rows)))
;; First run: sends and deletes
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (= 1 @send-count))
(t/is (= 0 (count-telemetry-rows)))
;; Second run: no events to send
(th/run-task! :telemetry {:send? true :enabled? true})
(t/is (= 1 @send-count)) ;; still 1, not 2
(t/is (= 0 (count-telemetry-rows)))))))

106
backend/test/backend_tests/util_blob_test.clj Normal file
View File

@ -0,0 +1,106 @@
;; 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) KALEIDOS INC
(ns backend-tests.util-blob-test
(:require
[app.util.blob :as blob]
[clojure.string :as str]
[clojure.test :as t]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; encode-str / decode-str round-trip
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest encode-str-roundtrip-empty-map
(let [data {}]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-empty-vector
(let [data []]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-nil
(let [data nil]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-simple-map
(let [data {:name "penpot" :version 42}]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-nested-structure
(let [data {:users [{:name "Alice" :tags #{"admin" "active"}}
{:name "Bob" :tags #{"user"}}]
:config {:debug false :timeout 3000}}]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-vector-of-maps
(let [data [{:name "navigate" :type "action" :source "telemetry"}
{:name "create-file" :type "action" :source "telemetry"}]]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-keywords-and-strings
(let [data {:keyword/value :foo
:string/value "hello world"
:boolean/value true
:nil/value nil}]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
(t/deftest encode-str-roundtrip-numeric-types
(let [data {:int 42
:neg -7
:zero 0
:big 9999999999}]
(t/is (= data (blob/decode-str (blob/encode-str data))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL-safe encoding properties
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest encode-str-url-safe-no-unsafe-chars
;; URL-safe base64 must not contain +, /, or padding =
(let [data {:a (apply str (repeat 100 "x"))
:b (range 200)
:c {"key" "value with special chars: @#$%^&*()"}}
encoded (blob/encode-str data)]
(t/is (not (str/includes? encoded "+")))
(t/is (not (str/includes? encoded "/")))
(t/is (not (str/includes? encoded "=")))))
(t/deftest encode-str-url-safe-roundtrip-after-encoding
;; Ensure the URL-safe encoding still round-trips correctly
(let [data {:payload (vec (range 500))
:nested {:a {:b {:c "deep"}}}}
encoded (blob/encode-str data)
decoded (blob/decode-str encoded)]
(t/is (= data decoded))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; version-specific encoding
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest encode-str-with-version-4
(let [data {:events [{:name "click"} {:name "scroll"}]}
encoded (blob/encode-str data {:version 4})
decoded (blob/decode-str encoded)]
(t/is (= data decoded))))
(t/deftest encode-str-with-version-5
(let [data {:events [{:name "click"} {:name "scroll"}]}
encoded (blob/encode-str data {:version 5})
decoded (blob/decode-str encoded)]
(t/is (= data decoded))))
(t/deftest encode-str-with-version-1
(let [data {:simple "data"}
encoded (blob/encode-str data {:version 1})
decoded (blob/decode-str encoded)]
(t/is (= data decoded))))
(t/deftest encode-str-with-version-3
(let [data {:simple "data"}
encoded (blob/encode-str data {:version 3})
decoded (blob/decode-str encoded)]
(t/is (= data decoded))))

2
frontend/package.json
View File

@ -31,7 +31,7 @@
"fmt:scss": "prettier -c resources/styles -c src/**/*.scss -w",
"lint:clj": "clj-kondo --parallel --lint ../common/src src/",
"lint:js": "exit 0",
"lint:scss": "pnpx stylelint '{src,resources}/**/*.scss'",
"lint:scss": "pnpm exec stylelint '{src,resources}/**/*.scss'",
"build:test": "clojure -M:dev:shadow-cljs compile test",
"test": "pnpm run build:wasm && pnpm run build:test && node target/tests/test.js",
"test:storybook": "vitest run --project=storybook",

7
frontend/src/app/main.cljs
View File

@ -76,11 +76,8 @@
ptk/WatchEvent
(watch [_ _ stream]
(rx/merge
(if (contains? cf/flags :audit-log)
(rx/of (ev/initialize))
(rx/empty))
(rx/of (dp/refresh-profile))
(rx/of (ev/initialize)
(dp/refresh-profile))
;; Watch for profile deletion events
(->> stream

26
frontend/src/app/main/data/auth.cljs
View File

@ -61,26 +61,30 @@
(rx/of (dcm/go-to-dashboard-recent {:team-id team-id})))))))]
(ptk/reify ::logged-in
ev/Event
(-data [_]
{::ev/name "signin"
::ev/type "identify"
:email (:email profile)
:auth-backend (:auth-backend profile)
:fullname (:fullname profile)
:is-muted (:is-muted profile)
:default-team-id (:default-team-id profile)
:default-project-id (:default-project-id profile)})
ptk/WatchEvent
(watch [_ _ stream]
(cf/initialize-external-context-info)
(->> (rx/merge
(rx/of (dp/set-profile profile)
(ws/initialize)
(dtm/fetch-teams))
;; We schedule this event to be executed a bit later,
;; when the profile is already set
(->> (rx/of (ev/event {::ev/name "signin"
::ev/type "identify"
:id (:id profile)
:email (:email profile)
:auth-backend (:auth-backend profile)
:fullname (:fullname profile)
:is-muted (:is-muted profile)
:default-team-id (:default-team-id profile)
:default-project-id (:default-project-id profile)}))
(rx/observe-on :async))
(->> stream
(rx/filter (ptk/type? ::dtm/teams-fetched))
(rx/take 1)

169
frontend/src/app/main/data/event.cljs
View File

@ -25,6 +25,7 @@
[app.util.storage :as storage]
[beicon.v2.core :as rx]
[beicon.v2.operators :as rxo]
[cuerdas.core :as str]
[lambdaisland.uri :as u]
[potok.v2.core :as ptk]))
@ -376,83 +377,105 @@
(l/debug :hint "event instrumentation initialized")
(->> (rx/merge
(->> (rx/from-atom buffer)
(rx/filter #(pos? (count %)))
(rx/debounce 2000))
(->> stream
(rx/filter (ptk/type? :app.main.data.profile/logout))
(rx/observe-on :async)))
(rx/map (fn [_]
(into [] (take max-chunk-size) @buffer)))
(rx/with-latest-from profile)
(rx/mapcat (fn [[chunk profile-id]]
(let [events (filterv #(= profile-id (:profile-id %)) chunk)]
(->> (persist-events events)
(rx/tap (fn [_]
(l/debug :hint "events chunk persisted" :total (count chunk))))
(rx/map (constantly chunk))))))
(rx/take-until stopper)
(rx/subs! (fn [chunk]
(swap! buffer remove-from-buffer (count chunk)))
(fn [cause]
(l/error :hint "unexpected error on audit persistence" :cause cause))
(fn []
(l/debug :hint "audit persistence terminated"))))
(->> (rx/merge
(->> stream
(rx/with-latest-from profile)
(rx/map make-event))
(->> (user-input-observer)
(rx/with-latest-from profile)
(rx/map make-performance-event)
(rx/debounce debounce-browser-event-time))
(->> (longtask-observer)
(rx/with-latest-from profile)
(rx/map make-performance-event)
(rx/debounce debounce-longtask-time))
(if (and (exists? js/globalThis)
(exists? (.-requestAnimationFrame js/globalThis))
(exists? (.-scheduler js/globalThis))
(exists? (.-postTask (.-scheduler js/globalThis))))
(->> stream
;; Fetch backend flags and only start event collection if
;; :audit-log or :telemetry is enabled. On RPC failure, proceed
;; with event collection anyway (backend will reject if truly disabled).
(->> (rp/cmd! :get-enabled-flags)
(rx/catch (fn [cause]
(l/debug :hint "unable to fetch backend flags, proceeding with event collection" :cause cause)
(rx/of #{:telemetry})))
(rx/mapcat (fn [flags]
(if (or (contains? flags :audit-log)
(contains? flags :telemetry))
(do
(l/debug :hint "event collection enabled" :flags (str/join " " (map name flags)))
(rx/of true))
(do
(l/debug :hint "event collection disabled (no audit-log or telemetry flag)")
(rx/empty)))))
(rx/take 1)
(rx/subs!
(fn [_]
;; Start the event collection pipeline
(->> (rx/merge
(->> (rx/from-atom buffer)
(rx/filter #(pos? (count %)))
(rx/debounce 2000))
(->> stream
(rx/filter (ptk/type? :app.main.data.profile/logout))
(rx/observe-on :async)))
(rx/map (fn [_]
(into [] (take max-chunk-size) @buffer)))
(rx/with-latest-from profile)
(rx/merge-map process-performance-event)
(rx/debounce debounce-performance-event-time))
(rx/empty)))
(rx/mapcat (fn [[chunk profile-id]]
(let [events (filterv #(= profile-id (:profile-id %)) chunk)]
(->> (persist-events events)
(rx/tap (fn [_]
(l/debug :hint "events chunk persisted" :total (count chunk))))
(rx/map (constantly chunk))))))
(rx/take-until stopper)
(rx/subs! (fn [chunk]
(swap! buffer remove-from-buffer (count chunk)))
(fn [cause]
(l/error :hint "unexpected error on audit persistence" :cause cause))
(fn []
(l/debug :hint "audit persistence terminated"))))
(rx/filter :profile-id)
(rx/map (fn [event]
(let [session* (or @session (ct/now))
context (-> @context
(merge (:context event))
(assoc :session session*)
(assoc :session-id cf/session-id)
(assoc :external-session-id (cf/external-session-id))
(add-external-context-info)
(d/without-nils))]
(reset! session session*)
(-> event
(assoc :timestamp (ct/now))
(assoc :context context)))))
(->> (rx/merge
(->> stream
(rx/with-latest-from profile)
(rx/map make-event))
(rx/tap (fn [event]
(l/debug :hint "event enqueued")
(swap! buffer append-to-buffer event)))
(->> (user-input-observer)
(rx/with-latest-from profile)
(rx/map make-performance-event)
(rx/debounce debounce-browser-event-time))
(rx/switch-map #(rx/timer session-timeout))
(rx/take-until stopper)
(rx/subs! (fn [_]
(l/debug :hint "session reinitialized")
(reset! session nil))
(fn [cause]
(l/error :hint "error on event batching stream" :cause cause))
(fn []
(l/debug :hitn "events batching stream terminated"))))))))
(->> (longtask-observer)
(rx/with-latest-from profile)
(rx/map make-performance-event)
(rx/debounce debounce-longtask-time))
(if (and (exists? js/globalThis)
(exists? (.-requestAnimationFrame js/globalThis))
(exists? (.-scheduler js/globalThis))
(exists? (.-postTask (.-scheduler js/globalThis))))
(->> stream
(rx/with-latest-from profile)
(rx/merge-map process-performance-event)
(rx/debounce debounce-performance-event-time))
(rx/empty)))
(rx/filter :profile-id)
(rx/map (fn [event]
(let [session* (or @session (ct/now))
context (-> @context
(merge (:context event))
(assoc :session session*)
(assoc :session-id cf/session-id)
(assoc :external-session-id (cf/external-session-id))
(add-external-context-info)
(d/without-nils))]
(reset! session session*)
(-> event
(assoc :timestamp (ct/now))
(assoc :context context)))))
(rx/tap (fn [event]
(l/debug :hint "event enqueued")
(swap! buffer append-to-buffer event)))
(rx/switch-map #(rx/timer session-timeout))
(rx/take-until stopper)
(rx/subs! (fn [_]
(l/debug :hint "session reinitialized")
(reset! session nil))
(fn [cause]
(l/error :hint "error on event batching stream" :cause cause))
(fn []
(l/debug :hint "events batching stream terminated")))))
(fn [cause]
(l/warn :hint "unexpected error during event collection initialization" :cause cause))))))))
(defn event
[props]

1
frontend/stylelint.config.mjs
View File

@ -13,6 +13,7 @@ export default {
rules: {
"at-rule-no-unknown": null,
"declaration-property-value-no-unknown": null,
"property-no-unknown": [true, { ignoreProperties: ["text-box"] }],
"selector-pseudo-class-no-unknown": [
true,
{ ignorePseudoClasses: ["global"] }, // TODO: Avoid global selector usage and remove this exception