♻️ Add labels support to metrics module.

And improve the rpc metrics using labels.

backend/src/app/metrics.clj

@@ -109,11 +109,13 @@
          (tdown# (/ (- (System/nanoTime) start#) 1000000))))))
 
 (defn make-counter
-  [{:keys [name help registry reg] :as props}]
+  [{:keys [name help registry reg labels] :as props}]
   (let [registry (or registry reg)
-        instance (doto (Counter/build)
+        instance (.. (Counter/build)
-                   (.name name)
+                     (name name)
-                   (.help help))
+                     (help help))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
     (reify
       clojure.lang.IDeref
@@ -121,14 +123,21 @@
 
       clojure.lang.IFn
       (invoke [_ cmd]
-        (.inc ^Counter instance)))))
+        (.inc ^Counter instance))
+
+      (invoke [_ cmd labels]
+        (.. ^Counter instance
+            (labels labels)
+            (inc))))))
 
 (defn make-gauge
-  [{:keys [name help registry reg] :as props}]
+  [{:keys [name help registry reg labels] :as props}]
   (let [registry (or registry reg)
-        instance (doto (Gauge/build)
+        instance (.. (Gauge/build)
-                   (.name name)
+                     (name name)
-                   (.help help))
+                     (help help))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
 
     (reify
@@ -139,17 +148,23 @@
       (invoke [_ cmd]
         (case cmd
           :inc (.inc ^Gauge instance)
-          :dec (.dec ^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] :as props}]
+  [{:keys [name help registry reg labels] :as props}]
   (let [registry (or registry reg)
         instance (doto (Summary/build)
                    (.name name)
                    (.help help)
-                   (.quantile 0.5 0.05)
+                   (.quantile 0.75 0.02)
-                   (.quantile 0.9 0.01)
                    (.quantile 0.99 0.001))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
     (reify
       clojure.lang.IDeref
@@ -157,7 +172,12 @@
 
       clojure.lang.IFn
       (invoke [_ cmd val]
-        (.observe ^Summary instance val)))))
+        (.observe ^Summary instance val))
+
+      (invoke [_ cmd val labels]
+        (.. ^Summary instance
+            (labels labels)
+            (observe val))))))
 
 (defn create
   [{:keys [type name] :as props}]
@@ -167,7 +187,7 @@
     :summary (make-summary props)))
 
 (defn wrap-counter
-  [rootf mobj]
+  ([rootf mobj]
    (let [mdata (meta rootf)
          origf (::original mdata rootf)]
      (with-meta
@@ -182,9 +202,25 @@
           (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]
+  ([rootf mobj]
    (let [mdata  (meta rootf)
          origf  (::original mdata rootf)]
      (with-meta
@@ -203,6 +239,26 @@
             :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)]

backend/src/app/rpc.clj

@@ -53,15 +53,8 @@
       (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
 
 (defn- wrap-with-metrics
-  [cfg f mdata prefix]
+  [cfg f mdata]
-  (let [mreg (get-in cfg [:metrics :registry])
+  (mtx/wrap-summary f (::mobj cfg) [(::sv/name mdata)]))
-        mobj (mtx/create
-              {:name (-> (str "rpc_" (name prefix) "_" (::sv/name mdata) "_response_millis")
-                         (str/replace "-" "_"))
-               :registry mreg
-               :type :summary
-               :help (str/fmt "Service '%s' response time in milliseconds." (::sv/name mdata))})]
-    (mtx/wrap-summary f mobj)))
 
 ;; Wrap the rpc handler with a semaphore if it is specified in the
 ;; metadata asocciated with the handler.
@@ -79,11 +72,10 @@
     f))
 
 (defn- wrap-impl
-  [cfg f mdata prefix]
+  [cfg f mdata]
   (let [f     (wrap-with-rlimits cfg f mdata)
-        f     (wrap-with-metrics cfg f mdata prefix)
+        f     (wrap-with-metrics cfg f mdata)
-        spec  (or (::sv/spec mdata)
+        spec  (or (::sv/spec mdata) (s/spec any?))]
-                  (s/spec any?))]
     (log/debugf "Registering '%s' command to rpc service." (::sv/name mdata))
     (fn [params]
       (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
@@ -93,13 +85,20 @@
       (f cfg (us/conform spec params)))))
 
 (defn- process-method
-  [cfg prefix vfn]
+  [cfg vfn]
   (let [mdata (meta vfn)]
     [(keyword (::sv/name mdata))
-     (wrap-impl cfg (deref vfn) mdata prefix)]))
+     (wrap-impl cfg (deref vfn) mdata)]))
 
 (defn- resolve-query-methods
   [cfg]
+  (let [mobj (mtx/create
+              {:name "rpc_query_timing"
+               :labels ["name"]
+               :registry (get-in cfg [:metrics :registry])
+               :type :summary
+               :help "Timing of query services."})
+        cfg  (assoc cfg ::mobj mobj)]
     (->> (sv/scan-ns 'app.rpc.queries.projects
                      'app.rpc.queries.files
                      'app.rpc.queries.teams
@@ -107,11 +106,18 @@
                      'app.rpc.queries.profile
                      'app.rpc.queries.recent-files
                      'app.rpc.queries.viewer)
-       (map (partial process-method cfg :query))
+         (map (partial process-method cfg))
-       (into {})))
+         (into {}))))
 
 (defn- resolve-mutation-methods
   [cfg]
+  (let [mobj (mtx/create
+              {:name "rpc_mutation_timing"
+               :labels ["name"]
+               :registry (get-in cfg [:metrics :registry])
+               :type :summary
+               :help "Timing of mutation services."})
+        cfg  (assoc cfg ::mobj mobj)]
     (->> (sv/scan-ns 'app.rpc.mutations.demo
                      'app.rpc.mutations.media
                      'app.rpc.mutations.profile
@@ -121,8 +127,8 @@
                      'app.rpc.mutations.viewer
                      'app.rpc.mutations.teams
                      'app.rpc.mutations.verify-token)
-       (map (partial process-method cfg :mutation))
+         (map (partial process-method cfg))
-       (into {})))
+         (into {}))))
 
 (s/def ::storage some?)
 (s/def ::session map?)