github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-12 13:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/backend/src/app/loggers/audit.clj

664 lines
23 KiB
Clojure
Raw Blame History

;; 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 SUBSIDIARY SL
(ns app.loggers.audit
"Services related to the user activity (audit log)."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.common.transit :as t]
[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.jobs :as jobs]
[app.loggers.audit.consumer-task :as consumer]
[app.loggers.audit.tasks :as-alias tasks]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.setup :as-alias setup]
[app.util.inet :as inet]
[app.util.services :as-alias sv]
[cuerdas.core :as str]
[yetti.request :as yreq]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private filter-auth-events
#{"login-with-oidc" "login-with-password" "register-profile" "update-profile"})
(def ^:private organization-sso-failure-reasons
#{"access-denied"
"provider-unavailable"
"invalid-configuration"
"provider-error"
"token-exchange-failed"
"user-info-failed"
"incomplete-user-info"
"unexpected-error"})
(def ^:private subscription-creation-events
#{"create-subscription" "create-trial-subscription"})
(def ^:private subscription-creation-telemetry-props
#{:type
:deployment
:quantity
:subscription-mode})
(def ^:private subscription-update-telemetry-props
#{:type
:deployment
:previous-status
:status
:previous-cancel-at-period-end
:cancel-at-period-end
:previous-cancel-at
:cancel-at
:changed-fields})
(def ^:private subscription-summary-telemetry-props
#{:type
:deployment
:instance-id
:snapshot-date
:trialing-count
:active-count
:active-cancel-scheduled-count
:past-due-count
:canceled-count
:unpaid-count
:incomplete-count
:incomplete-expired-count
:paused-count
:other-count
:total-count
:sync-succeeded
:sync-failed
:snapshot-complete})
(def ^:private safe-backend-context-keys
#{:version
:initiator
:client-version
:client-user-agent})
(def ^:private safe-frontend-context-keys
#{:version
:initiator
: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
:client-secret})
(defn extract-utm-params
"Extracts additional data from params and namespace them under
`penpot` ns."
[params]
(letfn [(process-param [params k v]
(let [sk (d/name k)]
(cond-> params
(str/starts-with? sk "utm_")
(assoc (->> sk str/kebab (keyword "penpot")) v)
(str/starts-with? sk "mtm_")
(assoc (->> sk str/kebab (keyword "penpot")) v))))]
(reduce-kv process-param {} params)))
(defn profile->props
[profile]
(-> profile
(select-keys profile-props)
(merge (:props profile))
(d/without-nils)))
(defn clean-props
[props]
(into {}
(comp
(d/without-nils)
(d/without-qualified)
(remove #(contains? reserved-props (key %))))
props))
(defn get-external-session-id
[request]
(when-let [session-id (yreq/get-header request "x-external-session-id")]
(when-not (or (> (count session-id) 256)
(= session-id "null")
(str/blank? session-id))
session-id)))
(defn- get-client-event-origin
[request]
(when-let [origin (yreq/get-header request "x-event-origin")]
(when-not (or (= origin "null")
(str/blank? origin))
(str/prune origin 200))))
(defn get-client-user-agent
[request]
(when-let [user-agent (yreq/get-header request "user-agent")]
(str/prune user-agent 500)))
(defn- get-client-version
[request]
(when-let [origin (yreq/get-header request "x-frontend-version")]
(when-not (or (= origin "null")
(str/blank? origin))
(str/prune origin 100))))
(def ^:private client-initiators
{"penpot-frontend" "app"
"penpot-admin-console" "admin-console"
;; TODO: legacy value sent by older admin-console releases, remove
;; it once they are all redeployed.
"penpot-nitrate" "admin-console"})
(defn get-client-initiator
"Resolve the event initiator from the `x-client` request header.
Never trusts client-sent context: missing or unknown values fall
back to \"app\"."
[request]
(let [product (some-> (yreq/get-header request "x-client")
(str/split #"/" 2)
(first)
(str/lower))]
(get client-initiators product "app")))
;; --- SPECS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COLLECTOR API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare prepare-context-from-request)
;; Defines a service that collects the audit/activity log using
;; internal database. Later this audit log can be transferred to
;; an external storage and data cleared.
(def ^:private schema:event
[:map {:title "AuditEvent"}
[: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}
[:or ::sm/fn ::sm/text :keyword]]])
(def ^:private check-event
(sm/check-fn schema:event))
(def valid-event?
(sm/validator schema: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 (d/name 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
;; Keep a pre-assigned id (process-event assigns one so
;; the webhook task can reference the stored row).
(update :id #(or % (uuid/next)))
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet))
params (select-keys params event-keys)
row (db/insert! cfg :audit-log params)]
;; The consumer queue follows the row in the same transaction: one
;; pending per enabled consumer. A rollback takes both on its way
;; out, so a row never outlives its queue.
(consumer/queue-pendings cfg [(:id row)])
row))
(def ^:private xf:filter-telemetry-props
"Transducer that keeps only map entries whose values are UUIDs,
booleans or numbers."
(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]
;; Assign the row id up-front so every sink below shares it: the
;; stored row and the `:process-webhook-event` task params. The
;; webhook trigger row links back to its origin event through props
;; `:event-id`, which used to land nil because the id was generated
;; inside `append-audit-entry` without reaching the worker params.
(let [event (assoc event :id (or (:id event) (uuid/next)))]
(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. The shadow row gets its own id: reusing the full row id
;; would collide on the primary key.
(let [event (-> event
(assoc :id (uuid/next))
(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))]
(jobs/submit cfg
{::jobs/name :process-webhook-event
::jobs/queue :webhooks
::jobs/max-retries 0
::jobs/delay (or batch-timeout 0)
::jobs/dedupe dedupe?
::jobs/label label
;; The event travels as an opaque transit blob:
;; transit preserves the instant/UUID/set types
;; that plain JSON props cannot carry.
::jobs/params {:event-blob
(t/encode-str
(-> event
(d/without-qualified)
(dissoc :source)
(dissoc :context)
(dissoc :ip-addr)
(dissoc :type)))}})))
event))
(defn submit*
"A public API, lower-level than 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
(and (= type "action")
(contains? subscription-creation-events name)
(or (= source "backend")
(= source "frontend")))
(let [props' (into {} xf:filter-telemetry-props props)
props' (merge props' (select-keys props subscription-creation-telemetry-props))]
(assoc params :props props'))
(and (= source "backend")
(= type "action")
(= name "update-subscription"))
(assoc params :props (select-keys props subscription-update-telemetry-props))
(and (= source "backend")
(= type "action")
(= name "subscription-summary"))
(assoc params :props (select-keys props subscription-summary-telemetry-props))
(and (= source "backend")
(= name "organization-sso-auth-failed"))
(let [props' (into {} xf:filter-telemetry-props props)
props' (cond-> props'
(contains? organization-sso-failure-reasons (:failure-reason props))
(assoc :failure-reason (:failure-reason props)))]
(assoc params :props props'))
(or (and (= source "frontend")
(= type "identify"))
(and (= source "backend")
(filter-auth-events name)))
(let [props' (into {} xf:filter-telemetry-props props)
props' (-> props'
(assoc :lang (:lang props))
(assoc :auth-backend (:auth-backend props))
(assoc :source (:source props))
(assoc :activation (:activation 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- coerce-profile-id
"Normalize a hand-written `::audit/profile-id` override to a uuid.
`schema:event` requires a uuid and `submit*` swallows the validation
error, so a value that is not a uuid loses the event instead of
failing loudly. Commands read the override from places that are not
typed by us (token claims, stringly-typed drivers), so a string has
to be accepted. Anything that cannot become a uuid is discarded, and
the event falls back to the caller, which is always a valid uuid."
[v]
(let [coerced (cond
;; Fast path: the override comes straight from a `profile`
;; row in almost every command, so it is already a uuid.
(uuid? v)
v
(string? v)
(uuid/parse* v)
:else
nil)]
(when (and (nil? coerced) (some? v))
(l/error :hint "ignoring unusable ::audit/profile-id"
:profile-id v))
coerced))
(def ^:private sql:team-id-by-project
"SELECT id FROM team
WHERE id = (SELECT team_id FROM project WHERE id = ?)")
(def ^:private sql:team-id-by-file
"SELECT t.id FROM team AS t
JOIN project AS p ON (p.team_id = t.id)
JOIN file AS f ON (f.project_id = p.id)
WHERE f.id = ?")
(def ^:private read-event-names
"Read commands excluded from team-id resolution on top of the `get-*`
prefix: their events carry no consumer state, so the lookup would only
tax the read path."
#{"has-file-libraries"})
(defn- read-event?
[event-name]
(or (str/starts-with? event-name "get-")
(contains? read-event-names event-name)))
(defn- enrich-team-id
"Adds the team id to the event props when it is missing and can be resolved
locally, so consumers do not have to join production tables. Only events that
already carry a project or file id are considered: read commands put the
entity id under `:id`, and resolving those would add a query to every read."
[cfg event-name props]
(if (or (:team-id props)
(read-event? event-name)
(and (nil? (:project-id props))
(nil? (:file-id props))))
props
(let [project-id (:project-id props)
file-id (:file-id props)
team-id (or (when (some? project-id)
(:id (db/exec-one! cfg [sql:team-id-by-project project-id])))
(when (some? file-id)
(:id (db/exec-one! cfg [sql:team-id-by-file file-id]))))]
(cond-> props
(some? team-id) (assoc :team-id team-id)))))
(defn prepare-rpc-event
[cfg mdata params result]
(let [resultm (meta result)
request (-> params meta ::http/request)
;; SECURITY: the event belongs to whoever made the request. The only
;; sanctioned override is the `::audit/profile-id` metadata, set
;; explicitly by the command. Never derive it from the response:
;; results can carry a `:profile-id` that belongs to somebody else
;; (the owner of an error report, the inviter of an invitation, ...)
;; and that silently misattributes the action.
profile-id (or (coerce-profile-id (::profile-id resultm))
(::rpc/profile-id params)
uuid/zero)
module (get cfg ::rpc/module)
event-name (or (::name resultm)
(let [sname (::sv/name mdata)]
(if (not= module "main")
(str module "-" sname)
sname)))
props (-> (or (::replace-props resultm)
(merge params (::props resultm)))
(clean-props))
;; Resolve the team locally when the event carries a project or file
;; id, so the consumers do not need to join production tables.
;; Reads are excluded: their events carry no consumer state.
props (enrich-team-id cfg event-name props)
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)]
{:type (or (::type resultm)
(::rpc/type cfg))
:name event-name
: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
;; audit/webhook specific object layout.
::rpc/params params
::webhooks/batch-key
(or (::webhooks/batch-key mdata)
(::webhooks/batch-key resultm))
::webhooks/batch-timeout
(or (::webhooks/batch-timeout mdata)
(::webhooks/batch-timeout resultm))
::webhooks/event?
(or (::webhooks/event? mdata)
(::webhooks/event? resultm)
false)}))
(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)
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 submit
"Submit an event to be registered under audit-log subsystem"
[cfg event]
(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 {})
(update :source d/nilv "backend")
(d/without-nils))]
(submit* cfg event)))
(defn submit-create-event
"Emits a `create-*` audit event for an entity created as a side effect of a
bulk operation (import, duplicate, clone). Those entities get no event from
their own command, so a local projection cannot key them otherwise. The
event is built by hand and does not pass through `prepare-rpc-event`, so its
props are passed as-is minus nils."
[cfg params event-name props]
(when (contains? cf/flags :audit-log)
(submit cfg
(-> (event-from-rpc-params params)
(assoc :name event-name)
(assoc :props (d/without-nils props))))))
(def ^:private sql:get-file-event-columns
"SELECT id, name, project_id, created_at, modified_at, revn
FROM file WHERE id = ?;")
(defn submit-file-created-event
"Emit a `create-file` event for a file born inside a bulk operation,
with the same prop shape as the `create-file` command event. Only
the file id is needed: the light columns are read back (no data
blob), so projections that key on name, revn or timestamps work.
`extra` carries what the row lacks (the team id)."
[cfg params file-id extra]
(when-let [row (db/exec-one! cfg [sql:get-file-event-columns file-id])]
(submit-create-event cfg params "create-file" (merge row extra))))
(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)
;; Transactional (not a bare connection): the row and its
;; pendings commit or vanish together (see append-audit-entry).
(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 {})
(update :source d/nilv "backend")
(select-keys event-keys)
(check-event))]
(db/tx-run! cfg append-audit-entry event))))
Reference in New Issue View Git Blame Copy Permalink