mirror of
https://github.com/penpot/penpot.git
synced 2026-06-01 21:20:18 +00:00
296 lines
8.0 KiB
Clojure
296 lines
8.0 KiB
Clojure
;; 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/.
|
|
;;
|
|
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
|
;; defined by the Mozilla Public License, v. 2.0.
|
|
;;
|
|
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
|
|
|
(ns app.metrics
|
|
(:require
|
|
[app.common.exceptions :as ex]
|
|
[app.util.time :as dt]
|
|
[app.worker]
|
|
[clojure.tools.logging :as log]
|
|
[clojure.spec.alpha :as s]
|
|
[cuerdas.core :as str]
|
|
[integrant.core :as ig]
|
|
[next.jdbc :as jdbc])
|
|
(:import
|
|
io.prometheus.client.CollectorRegistry
|
|
io.prometheus.client.Counter
|
|
io.prometheus.client.Gauge
|
|
io.prometheus.client.Summary
|
|
io.prometheus.client.exporter.common.TextFormat
|
|
io.prometheus.client.hotspot.DefaultExports
|
|
io.prometheus.client.jetty.JettyStatisticsCollector
|
|
org.eclipse.jetty.server.handler.StatisticsHandler
|
|
java.io.StringWriter))
|
|
|
|
(declare instrument-vars!)
|
|
(declare instrument)
|
|
(declare create-registry)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Entry Point
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- instrument-jdbc!
|
|
[registry]
|
|
(instrument-vars!
|
|
[#'next.jdbc/execute-one!
|
|
#'next.jdbc/execute!]
|
|
{:registry registry
|
|
:type :counter
|
|
:name "database_query_counter"
|
|
:help "An absolute counter of database queries."}))
|
|
|
|
(defn- instrument-workers!
|
|
[registry]
|
|
(instrument-vars!
|
|
[#'app.worker/run-task]
|
|
{:registry registry
|
|
:type :summary
|
|
:name "worker_task_checkout_millis"
|
|
:help "Latency measured between scheduld_at and execution time."
|
|
:wrap (fn [rootf mobj]
|
|
(let [mdata (meta rootf)
|
|
origf (::original mdata rootf)]
|
|
(with-meta
|
|
(fn [tasks item]
|
|
(let [now (inst-ms (dt/now))
|
|
sat (inst-ms (:scheduled-at item))]
|
|
(mobj :observe (- now sat))
|
|
(origf tasks item)))
|
|
{::original origf})))}))
|
|
|
|
(defn- handler
|
|
[registry request]
|
|
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
|
|
writer (StringWriter.)]
|
|
(TextFormat/write004 writer samples)
|
|
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
|
:body (.toString writer)}))
|
|
|
|
(defmethod ig/init-key ::metrics
|
|
[_ opts]
|
|
(log/infof "Initializing prometheus registry and instrumentation.")
|
|
(let [registry (create-registry)]
|
|
(instrument-workers! registry)
|
|
(instrument-jdbc! registry)
|
|
{:handler (partial handler registry)
|
|
:registry registry}))
|
|
|
|
(s/def ::handler fn?)
|
|
(s/def ::registry #(instance? CollectorRegistry %))
|
|
(s/def ::metrics
|
|
(s/keys :req-un [::registry ::handler]))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Implementation
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn create-registry
|
|
[]
|
|
(let [registry (CollectorRegistry.)]
|
|
(DefaultExports/register registry)
|
|
registry))
|
|
|
|
(defmacro with-measure
|
|
[& {:keys [expr cb]}]
|
|
`(let [start# (System/nanoTime)
|
|
tdown# ~cb]
|
|
(try
|
|
~expr
|
|
(finally
|
|
(tdown# (/ (- (System/nanoTime) start#) 1000000))))))
|
|
|
|
(defn make-counter
|
|
[{:keys [name help registry reg labels] :as props}]
|
|
(let [registry (or registry reg)
|
|
instance (.. (Counter/build)
|
|
(name name)
|
|
(help help))
|
|
_ (when (seq labels)
|
|
(.labelNames instance (into-array String labels)))
|
|
instance (.register instance registry)]
|
|
(reify
|
|
clojure.lang.IDeref
|
|
(deref [_] instance)
|
|
|
|
clojure.lang.IFn
|
|
(invoke [_ cmd]
|
|
(.inc ^Counter instance))
|
|
|
|
(invoke [_ cmd labels]
|
|
(.. ^Counter instance
|
|
(labels labels)
|
|
(inc))))))
|
|
|
|
(defn make-gauge
|
|
[{:keys [name help registry reg labels] :as props}]
|
|
(let [registry (or registry reg)
|
|
instance (.. (Gauge/build)
|
|
(name name)
|
|
(help help))
|
|
_ (when (seq labels)
|
|
(.labelNames instance (into-array String labels)))
|
|
instance (.register instance registry)]
|
|
|
|
(reify
|
|
clojure.lang.IDeref
|
|
(deref [_] instance)
|
|
|
|
clojure.lang.IFn
|
|
(invoke [_ cmd]
|
|
(case cmd
|
|
:inc (.inc ^Gauge instance)
|
|
:dec (.dec ^Gauge instance)))
|
|
|
|
(invoke [_ cmd labels]
|
|
(case cmd
|
|
:inc (.. ^Gauge instance (labels labels) (inc))
|
|
:dec (.. ^Gauge instance (labels labels) (dec)))))))
|
|
|
|
(defn make-summary
|
|
[{:keys [name help registry reg labels] :as props}]
|
|
(let [registry (or registry reg)
|
|
instance (doto (Summary/build)
|
|
(.name name)
|
|
(.help help)
|
|
(.quantile 0.75 0.02)
|
|
(.quantile 0.99 0.001))
|
|
_ (when (seq labels)
|
|
(.labelNames instance (into-array String labels)))
|
|
instance (.register instance registry)]
|
|
(reify
|
|
clojure.lang.IDeref
|
|
(deref [_] instance)
|
|
|
|
clojure.lang.IFn
|
|
(invoke [_ cmd val]
|
|
(.observe ^Summary instance val))
|
|
|
|
(invoke [_ cmd val labels]
|
|
(.. ^Summary instance
|
|
(labels labels)
|
|
(observe val))))))
|
|
|
|
(defn create
|
|
[{:keys [type name] :as props}]
|
|
(case type
|
|
:counter (make-counter props)
|
|
:gauge (make-gauge props)
|
|
:summary (make-summary props)))
|
|
|
|
(defn wrap-counter
|
|
([rootf mobj]
|
|
(let [mdata (meta rootf)
|
|
origf (::original mdata rootf)]
|
|
(with-meta
|
|
(fn
|
|
([a]
|
|
(mobj :inc)
|
|
(origf a))
|
|
([a b]
|
|
(mobj :inc)
|
|
(origf a b))
|
|
([a b & more]
|
|
(mobj :inc)
|
|
(apply origf a b more)))
|
|
(assoc mdata ::original origf))))
|
|
([rootf mobj labels]
|
|
(let [mdata (meta rootf)
|
|
labels (into-array String labels)
|
|
origf (::original mdata rootf)]
|
|
(with-meta
|
|
(fn
|
|
([a]
|
|
(mobj :inc)
|
|
(origf a))
|
|
([a b]
|
|
(mobj :inc)
|
|
(origf a b))
|
|
([a b & more]
|
|
(mobj :inc)
|
|
(apply origf a b more)))
|
|
(assoc mdata ::original origf)))))
|
|
|
|
(defn wrap-summary
|
|
([rootf mobj]
|
|
(let [mdata (meta rootf)
|
|
origf (::original mdata rootf)]
|
|
(with-meta
|
|
(fn
|
|
([a]
|
|
(with-measure
|
|
:expr (origf a)
|
|
:cb #(mobj :observe %)))
|
|
([a b]
|
|
(with-measure
|
|
:expr (origf a b)
|
|
:cb #(mobj :observe %)))
|
|
([a b & more]
|
|
(with-measure
|
|
:expr (apply origf a b more)
|
|
:cb #(mobj :observe %))))
|
|
(assoc mdata ::original origf))))
|
|
|
|
([rootf mobj labels]
|
|
(let [mdata (meta rootf)
|
|
labels (into-array String labels)
|
|
origf (::original mdata rootf)]
|
|
(with-meta
|
|
(fn
|
|
([a]
|
|
(with-measure
|
|
:expr (origf a)
|
|
:cb #(mobj :observe % labels)))
|
|
([a b]
|
|
(with-measure
|
|
:expr (origf a b)
|
|
:cb #(mobj :observe % labels)))
|
|
([a b & more]
|
|
(with-measure
|
|
:expr (apply origf a b more)
|
|
:cb #(mobj :observe % labels))))
|
|
(assoc mdata ::original origf)))))
|
|
|
|
(defn instrument-vars!
|
|
[vars {:keys [wrap] :as props}]
|
|
(let [obj (create props)]
|
|
(cond
|
|
(instance? Counter @obj)
|
|
(doseq [var vars]
|
|
(alter-var-root var (or wrap wrap-counter) obj))
|
|
|
|
(instance? Summary @obj)
|
|
(doseq [var vars]
|
|
(alter-var-root var (or wrap wrap-summary) obj))
|
|
|
|
:else
|
|
(ex/raise :type :not-implemented))))
|
|
|
|
(defn instrument
|
|
[f {:keys [wrap] :as props}]
|
|
(let [obj (create props)]
|
|
(cond
|
|
(instance? Counter @obj)
|
|
((or wrap wrap-counter) f obj)
|
|
|
|
(instance? Summary @obj)
|
|
((or wrap wrap-summary) f obj)
|
|
|
|
:else
|
|
(ex/raise :type :not-implemented))))
|
|
|
|
(defn instrument-jetty!
|
|
[^CollectorRegistry registry ^StatisticsHandler handler]
|
|
(doto (JettyStatisticsCollector. handler)
|
|
(.register registry))
|
|
nil)
|
|
|