Add prometheus service.

1 files changed, 148 insertions, 1 deletions

diff --git a/arunisaac/prometheus.scm b/arunisaac/prometheus.scm
index fb0aa80..9f2cef1 100644
--- a/arunisaac/prometheus.scm
+++ b/arunisaac/prometheus.scm
@@ -19,11 +19,38 @@
 ;;; <https://www.gnu.org/licenses/>.
 
 (define-module (arunisaac prometheus)
+  #:use-module (gnu build linux-container)
+  #:use-module ((gnu packages admin) #:select (shadow))
+  #:use-module ((gnu packages guile) #:select (guile-json-4))
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system shadow)
   #:use-module (guix build-system go)
   #:use-module (guix gexp)
   #:use-module (guix git-download)
+  #:use-module (guix least-authority)
   #:use-module ((guix licenses) #:prefix license:)
-  #:use-module (guix packages))
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:export (prometheus-configuration
+            prometheus-configuration?
+            this-prometheus-configuration
+            prometheus-configuration-package
+            prometheus-configuration-web-listen-address
+            prometheus-configuration-storage-tsdb-path
+            prometheus-configuration-scrape-configs
+            prometheus-scrape-config
+            prometheus-scrape-config?
+            prometheus-scrape-config-job-name
+            prometheus-scrape-config-scrape-interval
+            prometheus-scrape-config-static-configs
+            prometheus-static-config
+            prometheus-static-config?
+            prometheus-static-config-targets
+            prometheus-static-config-labels
+            prometheus-service-type))
 
 ;; This package definition is based on
 ;; https://codeberg.org/cbaines/guix/commit/9cb1166151b795ba6aaaf9db11e31cfc3f124c1d
@@ -76,3 +103,123 @@ toolkit. Prometheus collects and stores its metrics as time series data, i.e.
 metrics information is stored with the timestamp at which it was recorded,
 alongside optional key-value pairs called labels.")
     (license license:asl2.0)))
+
+(define-record-type* <prometheus-configuration>
+  prometheus-configuration make-prometheus-configuration
+  prometheus-configuration?
+  this-prometheus-configuration
+  (package prometheus-configuration-package
+           (default prometheus))
+  (web-listen-address prometheus-configuration-web-listen-address
+                      (default "localhost:9090"))
+  (storage-tsdb-path prometheus-configuration-storage-tsdb-path
+                     (default "/var/lib/prometheus/data/"))
+  (scrape-configs prometheus-configuration-scrape-configs
+                  (default '())
+                  ;; thunked so that scrape configs can reference the web listen
+                  ;; address
+                  (thunked)))
+
+(define-record-type* <prometheus-scrape-config>
+  prometheus-scrape-config make-prometheus-scrape-config
+  prometheus-scrape-config?
+  (job-name prometheus-scrape-config-job-name)
+  (scrape-interval prometheus-scrape-config-scrape-interval
+                   (default "1m"))
+  (static-configs prometheus-scrape-config-static-configs
+                  (default '())))
+
+(define-record-type* <prometheus-static-config>
+  prometheus-static-config make-prometheus-static-config
+  prometheus-static-config?
+  (targets prometheus-static-config-targets
+           (default '()))
+  (labels prometheus-static-config-labels
+          (default '())))
+
+(define %prometheus-accounts
+  (list (user-account
+          (name "prometheus")
+          (group "prometheus")
+          (system? #t)
+          (comment "Prometheus daemon user")
+          (home-directory "/var/lib/prometheus")
+          (shell (file-append shadow "/sbin/nologin")))
+        (user-group
+          (name "prometheus")
+          (system? #t))))
+
+(define scrape-config->tree
+  (match-record-lambda <prometheus-scrape-config>
+    (job-name scrape-interval static-configs)
+    ;; Vectors and dotted association lists cannot be lowered correctly into a
+    ;; G-expression. Hence we return a G-expression that evaluates to such a
+    ;; tree.
+    #~(list (cons "job_name" #$job-name)
+            (cons "scrape_interval" #$scrape-interval)
+            (cons "static_configs"
+                  (vector #$@(map (match-record-lambda <prometheus-static-config>
+                                    (targets labels)
+                                    #~(cons (cons "targets" (vector #$@targets))
+                                            #$(match labels
+                                                (() #~'())
+                                                (_ #~(cons "labels" #$label)))))
+                                  static-configs))))))
+
+(define prometheus-config-file-gexp
+  (match-record-lambda <prometheus-configuration>
+    (scrape-configs)
+    (with-extensions (list guile-json-4)
+      #~(begin
+          (use-modules (srfi srfi-26)
+                       (json))
+
+          (call-with-output-file #$output
+            ;; YAML is a superset of JSON. So, we can just write JSON.
+            (cut scm->json
+                 ;; Vectors and dotted association lists cannot be lowered
+                 ;; correctly into a G-expression. Hence we deal in
+                 ;; G-expressions that evaluate to such a tree.
+                 (list (cons "scrape_configs"
+                             (vector #$@(map scrape-config->tree
+                                             scrape-configs))))
+                 <>))))))
+
+(define (prometheus-shepherd-service config)
+  (match-record config <prometheus-configuration>
+    (package web-listen-address storage-tsdb-path)
+    (let ((config-file (computed-file "prometheus.yml"
+                                      (prometheus-config-file-gexp config))))
+      (shepherd-service
+        (documentation "Prometheus monitoring system and time series database.")
+        (provision '(prometheus))
+        (requirement '(networking))
+        (start #~(make-forkexec-constructor
+                  (list #$(least-authority-wrapper
+                           (file-append package "/bin/prometheus")
+                           #:name "prometheus-pola-wrapper"
+                           #:mappings (list (file-system-mapping
+                                              (source config-file)
+                                              (target source))
+                                            (file-system-mapping
+                                              (source "/var/lib/prometheus")
+                                              (target source)
+                                              (writable? #t)))
+                           #:namespaces (delq 'net %namespaces))
+                        "--config.file" #$config-file
+                        "--web.listen-address" #$web-listen-address
+                        "--storage.tsdb.path" #$storage-tsdb-path)
+                  #:user "prometheus"
+                  #:group "prometheus"
+                  #:log-file "/var/log/prometheus.log"))
+        (stop #~(make-kill-destructor))))))
+
+(define prometheus-service-type
+  (service-type
+   (name 'prometheus)
+   (description "Run Prometheus monitoring server.")
+   (extensions (list (service-extension account-service-type
+                                        (const %prometheus-accounts))
+                     (service-extension shepherd-root-service-type
+                                        (compose list prometheus-shepherd-service))))
+   (default-value (prometheus-configuration))))