Add Tribes edge services with Vinyl, Hitch, and Lego

manifests/substitutes/tribes-node.scm

@@ -3,7 +3,8 @@
   #:use-module (guix profiles)
   #:use-module (tribes packages otp)
   #:use-module (tribes packages source)
-  #:use-module (tribes packages terminals))
+  #:use-module (tribes packages terminals)
+  #:use-module (tribes packages web))
 
 (define %tribes-node-specifications
   '("nss-certs"
@@ -37,6 +38,9 @@
           elixir-otp28
           elixir-hex-otp28
           ghostty-terminfo
+          hitch
+          vinyl
+          lego
           (tribes-node-package)))))
 
 (make-tribes-node-manifest)

tribes/services/hitch.scm

@@ -0,0 +1,136 @@
+(define-module (tribes services hitch)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system shadow)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (tribes packages web)
+  #:export (hitch-configuration
+            hitch-configuration?
+            hitch-configuration-package
+            hitch-configuration-backend
+            hitch-configuration-frontends
+            hitch-configuration-pem-files
+            hitch-configuration-ciphers
+            hitch-configuration-user
+            hitch-configuration-group
+            hitch-configuration-pid-file
+            hitch-configuration-ocsp-dir
+            hitch-configuration-extra-config
+            hitch-service-type))
+
+(define-record-type* <hitch-configuration>
+  hitch-configuration make-hitch-configuration
+  hitch-configuration?
+  (package hitch-configuration-package
+           (default hitch))
+  (backend hitch-configuration-backend
+           (default "[127.0.0.1]:6081"))
+  (frontends hitch-configuration-frontends
+             (default '("[0.0.0.0]:443" "[::]:443")))
+  (pem-files hitch-configuration-pem-files
+             (default '()))
+  (ciphers hitch-configuration-ciphers
+           (default "EECDH+AESGCM:EDH+AESGCM:AES256+EECDH:AES256+EDH"))
+  (user hitch-configuration-user
+        (default "hitch"))
+  (group hitch-configuration-group
+         (default "hitch"))
+  (pid-file hitch-configuration-pid-file
+            (default "/var/run/hitch/hitch.pid"))
+  (ocsp-dir hitch-configuration-ocsp-dir
+            (default "/var/cache/hitch/ocsp"))
+  (extra-config hitch-configuration-extra-config
+                (default '())))
+
+(define %hitch-accounts
+  (list
+   (user-group
+    (name "hitch")
+    (system? #t))
+   (user-account
+    (name "hitch")
+    (group "hitch")
+    (system? #t)
+    (comment "Hitch TLS proxy user")
+    (home-directory "/var/empty")
+    (shell (file-append shadow "/sbin/nologin")))))
+
+(define (hitch-config-file config)
+  (match config
+    (($ <hitch-configuration> _ backend frontends pem-files ciphers user group
+                              pid-file ocsp-dir extra-config)
+     (plain-file
+      "hitch.conf"
+      (string-append
+       "backend = \"" backend "\"\n"
+       (string-concatenate
+        (map (lambda (frontend)
+               (string-append "frontend = \"" frontend "\"\n"))
+             frontends))
+       (string-concatenate
+        (map (lambda (pem-file)
+               (string-append "pem-file = \"" pem-file "\"\n"))
+             pem-files))
+       "ciphers = \"" ciphers "\"\n"
+       "user = \"" user "\"\n"
+       "group = \"" group "\"\n"
+       "pidfile = \"" pid-file "\"\n"
+       "ocsp-dir = \"" ocsp-dir "\"\n"
+       (string-concatenate
+        (map (lambda (line)
+               (string-append line "\n"))
+             extra-config)))))))
+
+(define (hitch-activation config)
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/run/hitch")
+      (mkdir-p #$(hitch-configuration-ocsp-dir config))))
+
+(define (hitch-shepherd-services config)
+  (let ((config-file (hitch-config-file config))
+        (pid-file (hitch-configuration-pid-file config))
+        (package (hitch-configuration-package config)))
+    (list
+     (shepherd-service
+      (documentation "Run the Hitch TLS proxy.")
+      (provision '(hitch))
+      (requirement '(user-processes networking))
+      (start
+       #~(make-forkexec-constructor
+          (list #$(file-append package "/sbin/hitch")
+                "--daemon"
+                "--config"
+                #$config-file)
+          #:pid-file #$pid-file))
+      (stop #~(make-kill-destructor))
+      (actions
+       (list
+        (shepherd-action
+         (name 'reload)
+         (documentation "Reload Hitch certificates and listeners.")
+         (procedure
+          #~(lambda _
+              (use-modules (ice-9 posix))
+              (let ((pid (call-with-input-file #$pid-file read)))
+                (kill pid SIGHUP)
+                #t))))))))))
+
+(define hitch-service-type
+  (service-type
+   (name 'hitch)
+   (extensions
+    (list (service-extension account-service-type
+                             (const %hitch-accounts))
+          (service-extension activation-service-type
+                             hitch-activation)
+          (service-extension shepherd-root-service-type
+                             hitch-shepherd-services)
+          (service-extension profile-service-type
+                             (compose list hitch-configuration-package))))
+   (default-value (hitch-configuration))
+   (description "Run the Hitch TLS proxy.")))

tribes/services/lego.scm

@@ -0,0 +1,315 @@
+(define-module (tribes services lego)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages tls)
+  #:use-module (gnu services)
+  #:use-module (gnu services herd)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-13)
+  #:use-module (tribes packages web)
+  #:export (lego-certificate-configuration
+            lego-certificate-configuration?
+            lego-certificate-configuration-name
+            lego-certificate-configuration-subjects
+            lego-certificate-configuration-email
+            lego-certificate-configuration-server
+            lego-certificate-configuration-profile
+            lego-certificate-configuration-listen-http
+            lego-certificate-configuration-webroot
+            lego-certificate-configuration-key-type
+            lego-certificate-configuration-renew-days
+            lego-certificate-configuration-reload-services
+            lego-certificate-directory
+            lego-certificate-full-pem
+            lego-configuration
+            lego-configuration?
+            lego-configuration-package
+            lego-configuration-renew-hours
+            lego-configuration-renew-minutes
+            lego-configuration-certificates
+            lego-service-type))
+
+(define-record-type* <lego-certificate-configuration>
+  lego-certificate-configuration make-lego-certificate-configuration
+  lego-certificate-configuration?
+  (name lego-certificate-configuration-name)
+  (subjects lego-certificate-configuration-subjects)
+  (email lego-certificate-configuration-email
+         (default #f))
+  (server lego-certificate-configuration-server
+          (default "https://acme-v02.api.letsencrypt.org/directory"))
+  (profile lego-certificate-configuration-profile
+           (default #f))
+  (listen-http lego-certificate-configuration-listen-http
+               (default #f))
+  (webroot lego-certificate-configuration-webroot
+           (default #f))
+  (key-type lego-certificate-configuration-key-type
+            (default "ec256"))
+  (renew-days lego-certificate-configuration-renew-days
+              (default #f))
+  (reload-services lego-certificate-configuration-reload-services
+                   (default '())))
+
+(define-record-type* <lego-configuration>
+  lego-configuration make-lego-configuration
+  lego-configuration?
+  (package lego-configuration-package
+           (default lego))
+  (renew-hours lego-configuration-renew-hours
+               (default '(0 12)))
+  (renew-minutes lego-configuration-renew-minutes
+                 (default '(17)))
+  (certificates lego-configuration-certificates
+                (default '())))
+
+(define (lego-certificate-directory certificate)
+  (string-append "/var/lib/lego/"
+                 (lego-certificate-configuration-name certificate)))
+
+(define (lego-certificate-full-pem certificate)
+  (string-append (lego-certificate-directory certificate) "/full.pem"))
+
+(define (subject->san-entry subject)
+  (if (and (not (string-any char-alphabetic? subject))
+           (string-any (lambda (chr)
+                         (or (char-numeric? chr)
+                             (char=? chr #\.)
+                             (char=? chr #\:)))
+                       subject))
+      (string-append "IP:" subject)
+      (string-append "DNS:" subject)))
+
+(define (certificate-key-name certificate)
+  (string-replace-substring
+   (car (lego-certificate-configuration-subjects certificate))
+   "*"
+   "_"))
+
+(define (lego-common-arguments certificate)
+  (let ((listen-http (lego-certificate-configuration-listen-http certificate))
+        (webroot (lego-certificate-configuration-webroot certificate))
+        (subjects (lego-certificate-configuration-subjects certificate))
+        (email (lego-certificate-configuration-email certificate))
+        (server (lego-certificate-configuration-server certificate))
+        (key-type (lego-certificate-configuration-key-type certificate))
+        (state-dir (lego-certificate-directory certificate)))
+    (append
+     (list "--accept-tos"
+           "--path" state-dir)
+     (if email
+         (list "--email" email)
+         '())
+     (if (and listen-http webroot)
+         (error "lego certificate cannot use both listen-http and webroot"
+                (lego-certificate-configuration-name certificate))
+         '())
+     (cond
+      (listen-http
+       (list "--http" "--http.port" listen-http))
+      (webroot
+       (list "--http" "--http.webroot" webroot))
+      (else
+       (list "--http")))
+     (if server
+         (list "--server" server)
+         '())
+     (list "--key-type" key-type)
+     (append-map (lambda (subject)
+                   (list "-d" subject))
+                 subjects))))
+
+(define (lego-self-signed-activation-gexp certificate)
+  (let* ((state-dir (lego-certificate-directory certificate))
+         (primary-subject (car (lego-certificate-configuration-subjects certificate)))
+         (san-string (string-append
+                      "subjectAltName="
+                      (string-join
+                       (map subject->san-entry
+                            (lego-certificate-configuration-subjects certificate))
+                       ",")))
+         (initial-cert (string-append state-dir "/initial.pem"))
+         (fullchain (string-append state-dir "/fullchain.pem"))
+         (chain (string-append state-dir "/chain.pem"))
+         (cert-output (string-append state-dir "/cert.pem"))
+         (key-output (string-append state-dir "/key.pem"))
+         (full-pem (string-append state-dir "/full.pem")))
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 textual-ports))
+        (mkdir-p #$state-dir)
+        (when #$(lego-certificate-configuration-webroot certificate)
+          (mkdir-p (string-append
+                    #$(lego-certificate-configuration-webroot certificate)
+                    "/.well-known/acme-challenge")))
+        (unless (file-exists? #$fullchain)
+          (invoke #$(file-append openssl "/bin/openssl")
+                  "req"
+                  "-x509"
+                  "-newkey" "rsa:2048"
+                  "-keyout" #$key-output
+                  "-out" #$initial-cert
+                  "-sha256"
+                  "-days" "1"
+                  "-nodes"
+                  "-subj" #$(string-append "/CN=" primary-subject)
+                  "-addext" #$san-string)
+          (copy-file #$initial-cert #$fullchain)
+          (copy-file #$initial-cert #$chain)
+          (copy-file #$initial-cert #$cert-output)
+          (call-with-output-file #$full-pem
+            (lambda (port)
+              (display (call-with-input-file #$key-output get-string-all) port)
+              (display (call-with-input-file #$fullchain get-string-all) port)))))))
+
+(define (lego-certificate-program config certificate)
+  (let* ((state-dir (lego-certificate-directory certificate))
+         (certificate-dir (string-append state-dir "/certificates"))
+         (key-name (certificate-key-name certificate))
+         (certificate-file (string-append certificate-dir "/" key-name ".crt"))
+         (issuer-file (string-append certificate-dir "/" key-name ".issuer.crt"))
+         (private-key (string-append certificate-dir "/" key-name ".key"))
+         (fullchain (string-append state-dir "/fullchain.pem"))
+         (chain (string-append state-dir "/chain.pem"))
+         (cert-output (string-append state-dir "/cert.pem"))
+         (key-output (string-append state-dir "/key.pem"))
+         (full-pem (string-append state-dir "/full.pem"))
+         (run-arguments
+          (append (lego-common-arguments certificate)
+                  (list "run")
+                  (if (lego-certificate-configuration-profile certificate)
+                      (list (string-append
+                             "--profile="
+                             (lego-certificate-configuration-profile certificate)))
+                      '())))
+         (renew-arguments
+          (append (lego-common-arguments certificate)
+                  (list "renew" "--no-random-sleep")
+                  (if (lego-certificate-configuration-profile certificate)
+                      (list (string-append
+                             "--profile="
+                             (lego-certificate-configuration-profile certificate)))
+                      '())
+                  (if (lego-certificate-configuration-renew-days certificate)
+                      (list "--days"
+                            (number->string
+                             (lego-certificate-configuration-renew-days certificate)))
+                      (list "--dynamic")))))
+    (program-file
+     (string-append "lego-" (lego-certificate-configuration-name certificate))
+     (with-imported-modules '((gnu services herd)
+                              (guix build utils))
+       #~(begin
+           (use-modules (gnu services herd)
+                        (guix build utils)
+                        (ice-9 textual-ports))
+
+           (define (file-contents path)
+             (and (file-exists? path)
+                  (call-with-input-file path get-string-all)))
+
+           (define (fullchain-changed?)
+             (let ((old (file-contents #$fullchain))
+                   (new (file-contents #$certificate-file)))
+               (not (equal? old new))))
+
+           (mkdir-p #$state-dir)
+
+           (let ((lego #$(file-append
+                          (lego-configuration-package config)
+                          "/bin/lego"))
+                 (run-args '#$run-arguments)
+                 (renew-args '#$renew-arguments))
+             (if (file-exists? #$certificate-file)
+                 (apply invoke lego renew-args)
+                 (apply invoke lego run-args)))
+
+           (when (and (file-exists? #$certificate-file)
+                      (fullchain-changed?))
+             (copy-file #$certificate-file #$fullchain)
+             (copy-file #$private-key #$key-output)
+             (if (file-exists? #$issuer-file)
+                 (copy-file #$issuer-file #$chain)
+                 (copy-file #$certificate-file #$chain))
+             (copy-file #$certificate-file #$cert-output)
+             (call-with-output-file #$full-pem
+               (lambda (port)
+                 (display (call-with-input-file #$key-output get-string-all) port)
+                 (display (call-with-input-file #$fullchain get-string-all) port)))
+             #$@(map (lambda (service)
+                       #~(with-shepherd-action '#$service ('reload) result result))
+                     (lego-certificate-configuration-reload-services certificate))))))))
+
+(define (lego-certificate-service-symbol prefix certificate)
+  (string->symbol
+   (string-append prefix
+                  "-"
+                  (lego-certificate-configuration-name certificate))))
+
+(define (lego-renewal-services config)
+  (append-map
+   (lambda (certificate)
+     (let ((program (lego-certificate-program config certificate)))
+       (list
+        (shepherd-service
+         (documentation
+          (string-append "Renew the ACME certificate for "
+                         (lego-certificate-configuration-name certificate)
+                         " on a timer."))
+         (provision
+          (list (lego-certificate-service-symbol "lego-renewal"
+                                                 certificate)))
+         (requirement '(user-processes networking))
+         (modules '((shepherd service timer)))
+         (start
+          #~(let ((minutes '#$(lego-configuration-renew-minutes config))
+                  (hours '#$(lego-configuration-renew-hours config)))
+               (make-timer-constructor
+                (calendar-event
+                 #:minutes minutes
+                 #:hours hours)
+               (command (list #$program))
+               #:wait-for-termination? #t)))
+         (stop #~(make-timer-destructor))
+         (actions
+          (list shepherd-trigger-action
+                (shepherd-configuration-action program))))
+        (shepherd-service
+         (documentation
+          (string-append "Attempt ACME renewal for "
+                         (lego-certificate-configuration-name certificate)
+                         " at boot."))
+         (provision
+          (list (lego-certificate-service-symbol "lego-bootstrap"
+                                                 certificate)))
+         (requirement '(user-processes networking))
+         (one-shot? #t)
+         (start #~(lambda _
+                    (zero? (system* #$program))))
+         (respawn? #f)))))
+   (lego-configuration-certificates config)))
+
+(define (lego-activation config)
+  (let ((certificates (lego-configuration-certificates config)))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 textual-ports))
+          (mkdir-p "/var/lib/lego")
+          #$@(map lego-self-signed-activation-gexp certificates)))))
+
+(define lego-service-type
+  (service-type
+   (name 'lego)
+   (extensions
+    (list (service-extension activation-service-type
+                             lego-activation)
+          (service-extension shepherd-root-service-type
+                             lego-renewal-services)
+          (service-extension profile-service-type
+                             (compose list lego-configuration-package))))
+   (default-value (lego-configuration))
+   (description "Issue and renew ACME certificates with Lego.")))

tribes/services/tribes.scm

@@ -22,6 +22,8 @@
             tribes-configuration-working-directory
             tribes-configuration-plugin-directory
             tribes-configuration-host
+            tribes-configuration-listen-address
+            tribes-configuration-listen-port
             tribes-configuration-scheme
             tribes-configuration-port
             tribes-configuration-relay-url
@@ -54,6 +56,10 @@
                     (default "/var/lib/tribes/plugins"))
   (host tribes-configuration-host
         (default "localhost"))
+  (listen-address tribes-configuration-listen-address
+                  (default #f))
+  (listen-port tribes-configuration-listen-port
+               (default 4000))
   (scheme tribes-configuration-scheme
           (default "http"))
   (port tribes-configuration-port
@@ -137,7 +143,8 @@
      (list
       #~(setenv "HOME" #$(tribes-configuration-working-directory config))
       #~(setenv "PHX_SERVER" "true")
-      #~(setenv "PORT" #$(number->string (tribes-configuration-port config)))
+      #~(setenv "PORT" #$(number->string
+                          (tribes-configuration-listen-port config)))
       #~(setenv "PHX_HOST" #$(tribes-configuration-host config))
       #~(setenv "DATABASE_URL"
                 #$(tribes-database-url
@@ -158,6 +165,10 @@
                    ","))
       #~(setenv "SSL_CERT_DIR" "/etc/ssl/certs")
       #~(setenv "SSL_CERT_FILE" "/etc/ssl/certs/ca-certificates.crt"))
+     (if (tribes-configuration-listen-address config)
+         (list #~(setenv "BIND_ADDRESS"
+                         #$(tribes-configuration-listen-address config)))
+         '())
      (if (tribes-configuration-host-manifest config)
          (list #~(setenv "TRIBES_HOST_MANIFEST"
                          #$(tribes-configuration-host-manifest config)))

tribes/services/vinyl.scm

@@ -0,0 +1,129 @@
+(define-module (tribes services vinyl)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system shadow)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (tribes packages web)
+  #:export (vinyl-configuration
+            vinyl-configuration?
+            vinyl-configuration-package
+            vinyl-configuration-name
+            vinyl-configuration-backend
+            vinyl-configuration-vcl
+            vinyl-configuration-listen
+            vinyl-configuration-storage
+            vinyl-configuration-parameters
+            vinyl-configuration-extra-options
+            vinyl-service-type))
+
+(define-record-type* <vinyl-configuration>
+  vinyl-configuration make-vinyl-configuration
+  vinyl-configuration?
+  (package vinyl-configuration-package
+           (default vinyl))
+  (name vinyl-configuration-name
+        (default "main"))
+  (backend vinyl-configuration-backend
+           (default "127.0.0.1:4000"))
+  (vcl vinyl-configuration-vcl
+       (default #f))
+  (listen vinyl-configuration-listen
+          (default '("0.0.0.0:6081" "[::]:6081")))
+  (storage vinyl-configuration-storage
+           (default '("malloc,256M")))
+  (parameters vinyl-configuration-parameters
+              (default '()))
+  (extra-options vinyl-configuration-extra-options
+                 (default '())))
+
+(define %vinyl-accounts
+  (list
+   (user-group
+    (name "vinyl")
+    (system? #t))
+   (user-account
+    (name "vinyl")
+    (group "vinyl")
+    (system? #t)
+    (comment "Vinyl cache user")
+    (home-directory "/var/vinyl")
+    (shell (file-append shadow "/sbin/nologin")))))
+
+(define (vinyl-state-directory name)
+  (if (string-prefix? "/" name)
+      name
+      (string-append "/var/vinyl/" name)))
+
+(define (vinyl-activation-gexp config)
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/vinyl")
+      (mkdir-p #$(vinyl-state-directory
+                  (vinyl-configuration-name config)))))
+
+(define (vinyl-activation configs)
+  #~(begin
+      #$@(map vinyl-activation-gexp configs)))
+
+(define (vinyl-shepherd-services configs)
+  (append-map
+   (lambda (config)
+     (match config
+       (($ <vinyl-configuration> package name backend vcl listen storage
+                                 parameters extra-options)
+        (let ((pid-file (string-append (vinyl-state-directory name) "/_.pid")))
+          (list
+           (shepherd-service
+            (documentation (string-append "Run the Vinyl cache service (" name ")."))
+            (provision (list (string->symbol (string-append "vinyl-" name))))
+            (requirement '(user-processes networking))
+            (start
+             #~(make-forkexec-constructor
+                (list #$(file-append package "/sbin/vinyld")
+                      "-n" #$name
+                      #$@(if vcl
+                             #~("-f" #$vcl)
+                             #~("-b" #$backend))
+                      #$@(append-map (lambda (address)
+                                       (list "-a" address))
+                                     listen)
+                      #$@(append-map (lambda (storage-spec)
+                                       (list "-s" storage-spec))
+                                     storage)
+                      #$@(append-map (lambda (parameter)
+                                       (list "-p"
+                                             (format #f "~a=~a"
+                                                     (car parameter)
+                                                     (cdr parameter))))
+                                     parameters)
+                      #$@extra-options)
+                ;; Vinyl drops privileges on its own after binding the listeners,
+                ;; so keep the Shepherd service itself unprivileged here.
+                #:pid-file #$pid-file))
+            (stop #~(make-kill-destructor))))))))
+   configs))
+
+(define (vinyl-profile-packages configs)
+  (delete-duplicates
+   (map vinyl-configuration-package configs)))
+
+(define vinyl-service-type
+  (service-type
+   (name 'vinyl)
+   (extensions
+    (list (service-extension account-service-type
+                             (const %vinyl-accounts))
+          (service-extension activation-service-type
+                             vinyl-activation)
+          (service-extension shepherd-root-service-type
+                             vinyl-shepherd-services)
+          (service-extension profile-service-type
+                             vinyl-profile-packages)))
+   (compose concatenate)
+   (extend append)
+   (default-value '())
+   (description "Run the Vinyl HTTP accelerator and reverse proxy.")))

tribes/system/installer.scm

@@ -19,6 +19,14 @@
             (error "invalid integer environment variable" name value))
         default)))
 
+(define (getenv/bool name default)
+  (let ((value (getenv name)))
+    (if value
+        (if (member (string-downcase value) '("1" "true" "yes" "on"))
+            #t
+            #f)
+        default)))
+
 (define (comma-list value)
   (if (or (not value) (string-null? value))
       '()
@@ -26,6 +34,16 @@
            (filter (lambda (item) (not (string-null? item)))
                    (string-split value #\,)))))
 
+(define (safe-name value)
+  (list->string
+   (map (lambda (chr)
+          (if (or (char-alphabetic? chr)
+                  (char-numeric? chr)
+                  (char=? chr #\-))
+              chr
+              #\-))
+        (string->list value))))
+
 (define (tribes-installer-package)
   (let ((source-directory (getenv "TRIBES_SOURCE_DIRECTORY")))
     (if source-directory
@@ -47,9 +65,15 @@
   "Return an installed NBDE operating-system extended with PostgreSQL and the
 Tribes service.  By default it uses the pinned upstream package; setting
 TRIBES_SOURCE_DIRECTORY switches to a development source override."
-  (let* ((service-user (getenv/default "TRIBES_SERVICE_USER" "tribes"))
+  (let* ((edge-enabled? (getenv/bool "TRIBES_ENABLE_EDGE" #f))
+         (service-user (getenv/default "TRIBES_SERVICE_USER" "tribes"))
          (service-group (getenv/default "TRIBES_SERVICE_GROUP" service-user))
          (database-user (getenv/default "TRIBES_DATABASE_USER" service-user))
+         (public-host (getenv/default "TRIBES_PUBLIC_HOST" host-name))
+         (public-port (getenv/integer "TRIBES_HTTP_PORT"
+                                      (if edge-enabled? 443 4000)))
+         (listen-port (getenv/integer "TRIBES_LISTEN_PORT"
+                                      (if edge-enabled? 4000 public-port)))
          (package (tribes-installer-package))
          (tribes-config
           (tribes-configuration
@@ -60,9 +84,14 @@ TRIBES_SOURCE_DIRECTORY switches to a development source override."
             (getenv/default "TRIBES_WORKING_DIRECTORY" "/var/lib/tribes"))
            (plugin-directory
             (getenv/default "TRIBES_PLUGIN_DIRECTORY" "/var/lib/tribes/plugins"))
-           (host (getenv/default "TRIBES_PUBLIC_HOST" host-name))
+           (host public-host)
-           (scheme (getenv/default "TRIBES_SCHEME" "http"))
+           (listen-address
-           (port (getenv/integer "TRIBES_HTTP_PORT" 4000))
+            (getenv/default "TRIBES_LISTEN_ADDRESS"
+                            (and edge-enabled? "127.0.0.1")))
+           (listen-port listen-port)
+           (scheme (getenv/default "TRIBES_SCHEME"
+                                   (if edge-enabled? "https" "http")))
+           (port public-port)
            (relay-url (getenv "TRIBES_RELAY_URL"))
            (host-manifest (getenv "TRIBES_HOST_MANIFEST"))
            (admin-pubkeys
@@ -87,11 +116,39 @@ TRIBES_SOURCE_DIRECTORY switches to a development source override."
             (comma-list (getenv "TRIBES_EXTRA_ENV")))
            (log-file
             (getenv/default "TRIBES_LOG_FILE" "/var/log/tribes/tribes.log"))))
+         (edge-config
+          (and edge-enabled?
+               (tribes-edge-configuration
+                (certificate-name
+                 (getenv/default "TRIBES_ACME_CERTIFICATE_NAME"
+                                 (safe-name public-host)))
+                (certificate-subjects
+                 (let ((subjects (comma-list (getenv "TRIBES_ACME_SUBJECTS"))))
+                   (if (null? subjects)
+                       (list public-host)
+                       subjects)))
+                (certificate-email
+                 (or (getenv "TRIBES_ACME_EMAIL")
+                     (error "TRIBES_ACME_EMAIL is required when TRIBES_ENABLE_EDGE is true")))
+                (certificate-profile
+                 (getenv/default "TRIBES_ACME_PROFILE" "shortlived"))
+                (renew-days (getenv/integer "TRIBES_ACME_RENEW_DAYS" 4))
+                (http-port (getenv/integer "TRIBES_EDGE_HTTP_PORT" 80))
+                (https-port (getenv/integer "TRIBES_EDGE_HTTPS_PORT" 443))
+                (challenge-address
+                 (getenv/default "TRIBES_ACME_LISTEN_ADDRESS" "127.0.0.1"))
+                (challenge-port
+                 (getenv/integer "TRIBES_ACME_LISTEN_PORT" 8080))
+                (cache-address
+                 (getenv/default "TRIBES_EDGE_CACHE_ADDRESS" "127.0.0.1"))
+                (cache-port
+                 (getenv/integer "TRIBES_EDGE_CACHE_PORT" 6081)))))
          (node-config
           (tribes-node-configuration
            (postgresql (postgresql-configuration
                         (postgresql postgresql)))
-           (tribes tribes-config))))
+           (tribes tribes-config)
+           (edge edge-config))))
     (nbde-installed-operating-system
      #:host-name host-name
      #:bootloader bootloader

tribes/system/node.scm

@@ -2,14 +2,62 @@
   #:use-module (gnu packages databases)
   #:use-module (gnu services)
   #:use-module (gnu services databases)
+  #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (srfi srfi-13)
+  #:use-module (tribes services hitch)
+  #:use-module (tribes services lego)
   #:use-module (tribes services tribes)
-  #:export (tribes-node-configuration
+  #:use-module (tribes services vinyl)
+  #:export (tribes-edge-configuration
+            tribes-edge-configuration?
+            tribes-edge-configuration-certificate-name
+            tribes-edge-configuration-certificate-subjects
+            tribes-edge-configuration-certificate-email
+            tribes-edge-configuration-certificate-profile
+            tribes-edge-configuration-renew-days
+            tribes-edge-configuration-http-port
+            tribes-edge-configuration-https-port
+            tribes-edge-configuration-challenge-address
+            tribes-edge-configuration-challenge-port
+            tribes-edge-configuration-cache-address
+            tribes-edge-configuration-cache-port
+            tribes-edge-configuration-cache-storage
+            tribes-node-configuration
             tribes-node-configuration?
             tribes-node-configuration-postgresql
             tribes-node-configuration-tribes
+            tribes-node-configuration-edge
             tribes-node-services))
 
+(define-record-type* <tribes-edge-configuration>
+  tribes-edge-configuration make-tribes-edge-configuration
+  tribes-edge-configuration?
+  (certificate-name tribes-edge-configuration-certificate-name
+                    (default "tribes"))
+  (certificate-subjects tribes-edge-configuration-certificate-subjects
+                        (default '()))
+  (certificate-email tribes-edge-configuration-certificate-email
+                     (default #f))
+  (certificate-profile tribes-edge-configuration-certificate-profile
+                       (default "shortlived"))
+  (renew-days tribes-edge-configuration-renew-days
+              (default 4))
+  (http-port tribes-edge-configuration-http-port
+             (default 80))
+  (https-port tribes-edge-configuration-https-port
+              (default 443))
+  (challenge-address tribes-edge-configuration-challenge-address
+                     (default "127.0.0.1"))
+  (challenge-port tribes-edge-configuration-challenge-port
+                  (default 8080))
+  (cache-address tribes-edge-configuration-cache-address
+                 (default "127.0.0.1"))
+  (cache-port tribes-edge-configuration-cache-port
+              (default 6081))
+  (cache-storage tribes-edge-configuration-cache-storage
+                 (default '("malloc,256M"))))
+
 (define-record-type* <tribes-node-configuration>
   tribes-node-configuration make-tribes-node-configuration
   tribes-node-configuration?
@@ -17,7 +65,9 @@
               (default (postgresql-configuration
                         (postgresql postgresql))))
   (tribes tribes-node-configuration-tribes
-          (default (tribes-configuration))))
+          (default (tribes-configuration)))
+  (edge tribes-node-configuration-edge
+        (default #f)))
 
 (define (tribes-node-postgresql-roles config)
   (let ((tribes (tribes-node-configuration-tribes config)))
@@ -26,12 +76,169 @@
       (name (tribes-configuration-database-user tribes))
       (permissions '(createdb login))))))
 
+(define (edge-certificate-subjects edge tribes)
+  (let ((subjects (tribes-edge-configuration-certificate-subjects edge)))
+    (if (null? subjects)
+        (list (tribes-configuration-host tribes))
+        subjects)))
+
+(define (edge-certificate-config edge tribes)
+  (let ((subjects (edge-certificate-subjects edge tribes))
+        (email (tribes-edge-configuration-certificate-email edge)))
+    (unless email
+      (error "edge certificate email is required"
+             (tribes-edge-configuration-certificate-name edge)))
+    (lego-certificate-configuration
+     (name (tribes-edge-configuration-certificate-name edge))
+     (subjects subjects)
+     (email email)
+     (profile (tribes-edge-configuration-certificate-profile edge))
+     (listen-http
+      (format #f "~a:~a"
+              (tribes-edge-configuration-challenge-address edge)
+              (tribes-edge-configuration-challenge-port edge)))
+     (renew-days (tribes-edge-configuration-renew-days edge))
+     (reload-services '(hitch)))))
+
+(define (edge-http-vcl edge)
+  (plain-file
+   "tribes-edge-http.vcl"
+   (string-append
+    "vcl 4.1;\n\n"
+    "backend acme {\n"
+    "  .host = \"" (tribes-edge-configuration-challenge-address edge) "\";\n"
+    "  .port = \"" (number->string
+                    (tribes-edge-configuration-challenge-port edge)) "\";\n"
+    "}\n\n"
+    "sub vcl_recv {\n"
+    "  if (req.url ~ \"^/\\\\.well-known/acme-challenge/\") {\n"
+    "    return (pass);\n"
+    "  }\n\n"
+    "  return (synth(750));\n"
+    "}\n\n"
+    "sub vcl_synth {\n"
+    "  if (resp.status == 750) {\n"
+    "    set resp.status = 308;\n"
+    "    set resp.http.Location = \"https://\" + req.http.host + req.url;\n"
+    "    return (deliver);\n"
+    "  }\n"
+    "}\n\n"
+    "sub vcl_backend_response {\n"
+    "  set beresp.uncacheable = true;\n"
+    "  return (deliver);\n"
+    "}\n")))
+
+(define (edge-cache-vcl edge tribes)
+  (plain-file
+   "tribes-edge-cache.vcl"
+   (string-append
+    "vcl 4.1;\n\n"
+    "backend tribes {\n"
+    "  .host = \"" (or (tribes-configuration-listen-address tribes)
+                       "127.0.0.1") "\";\n"
+    "  .port = \"" (number->string
+                    (tribes-configuration-listen-port tribes)) "\";\n"
+    "  .probe = {\n"
+    "    .url = \"/healthz\";\n"
+    "    .interval = 5s;\n"
+    "    .timeout = 1s;\n"
+    "    .window = 5;\n"
+    "    .threshold = 3;\n"
+    "  }\n"
+    "}\n\n"
+    "sub vcl_recv {\n"
+    "  set req.http.X-Forwarded-Proto = \"https\";\n"
+    "  set req.http.X-Forwarded-Port = \"" (number->string
+                                           (tribes-edge-configuration-https-port edge))
+    "\";\n"
+    "  set req.http.X-Forwarded-Host = req.http.host;\n"
+    "  if (req.restarts == 0) {\n"
+    "    if (req.http.X-Forwarded-For) {\n"
+    "      set req.http.X-Forwarded-For = req.http.X-Forwarded-For + \", \" + client.ip;\n"
+    "    } else {\n"
+    "      set req.http.X-Forwarded-For = client.ip;\n"
+    "    }\n"
+    "  }\n\n"
+    "  if (req.http.Upgrade ~ \"(?i)websocket\" ||\n"
+    "      req.url ~ \"^/(live|ws/gql|nostr/relay)\") {\n"
+    "    return (pipe);\n"
+    "  }\n\n"
+    "  if (req.method != \"GET\" && req.method != \"HEAD\") {\n"
+    "    return (pass);\n"
+    "  }\n\n"
+    "  if (req.url ~ \"^/(assets/|fonts/|images/)\" ||\n"
+    "      req.url ~ \"^/(favicon\\\\.ico|robots\\\\.txt)$\") {\n"
+    "    return (hash);\n"
+    "  }\n\n"
+    "  return (pass);\n"
+    "}\n\n"
+    "sub vcl_backend_response {\n"
+    "  if (bereq.url ~ \"^/(assets/|fonts/|images/)\" ||\n"
+    "      bereq.url ~ \"^/(favicon\\\\.ico|robots\\\\.txt)$\") {\n"
+    "    unset beresp.http.Set-Cookie;\n"
+    "    set beresp.ttl = 1h;\n"
+    "    set beresp.grace = 5m;\n"
+    "    return (deliver);\n"
+    "  }\n\n"
+    "  set beresp.uncacheable = true;\n"
+    "  set beresp.ttl = 0s;\n"
+    "  return (deliver);\n"
+    "}\n\n"
+    "sub vcl_deliver {\n"
+    "  if (obj.hits > 0) {\n"
+    "    set resp.http.X-Cache = \"HIT\";\n"
+    "  } else {\n"
+    "    set resp.http.X-Cache = \"MISS\";\n"
+    "  }\n"
+    "}\n")))
+
+(define (edge-services config)
+  (let* ((tribes (tribes-node-configuration-tribes config))
+         (edge (tribes-node-configuration-edge config))
+         (certificate (edge-certificate-config edge tribes))
+         (cache-port (tribes-edge-configuration-cache-port edge))
+         (http-port (tribes-edge-configuration-http-port edge))
+         (https-port (tribes-edge-configuration-https-port edge)))
+    (list
+     (service lego-service-type
+              (lego-configuration
+               (certificates (list certificate))))
+     (service vinyl-service-type
+              (list
+               (vinyl-configuration
+                (name "tribes-http")
+                (vcl (edge-http-vcl edge))
+                (listen (list (string-append "0.0.0.0:" (number->string http-port))
+                              (string-append "[::]:" (number->string http-port))))
+                (storage '("malloc,64M")))
+               (vinyl-configuration
+                (name "tribes-edge")
+                (vcl (edge-cache-vcl edge tribes))
+                (listen
+                 (list (string-append
+                        (tribes-edge-configuration-cache-address edge)
+                        ":"
+                        (number->string cache-port))))
+                (storage (tribes-edge-configuration-cache-storage edge)))))
+     (service hitch-service-type
+              (hitch-configuration
+               (backend (format #f "[~a]:~a"
+                                (tribes-edge-configuration-cache-address edge)
+                                cache-port))
+               (frontends (list (format #f "[0.0.0.0]:~a" https-port)
+                                (format #f "[::]:~a" https-port)))
+               (pem-files (list (lego-certificate-full-pem certificate))))))))
+
 (define (tribes-node-services config)
-  (list
+  (append
-   (service postgresql-service-type
+   (list
-            (tribes-node-configuration-postgresql config))
+    (service postgresql-service-type
-   (simple-service 'tribes-postgresql-roles
+             (tribes-node-configuration-postgresql config))
-                   postgresql-role-service-type
+    (simple-service 'tribes-postgresql-roles
-                   (tribes-node-postgresql-roles config))
+                    postgresql-role-service-type
-   (service tribes-service-type
+                    (tribes-node-postgresql-roles config))
-            (tribes-node-configuration-tribes config))))
+    (service tribes-service-type
+             (tribes-node-configuration-tribes config)))
+   (if (tribes-node-configuration-edge config)
+       (edge-services config)
+       '())))