chore: update Tribes pin for mesh sync refresh

Compile the in-tree tribes_ui Mix project during the Tribes release build and install its ebin output into the packaged plugin directory so the runtime plugin loader can load the entry module.

.guix-authorizations

@@ -5,4 +5,6 @@
  (version 0)
 
  (("6688 9153 C51C 4613 A493  A525 2F0D FD14 EF99 DAC3"
-   (name "steffen"))))
+   (name "steffen"))
+  ("F29B A6DA 96E5 EC29 FDDE  D994 8F4F 75B3 B19D 4784"
+   (name "tribes-supertest-dev"))))

supertest-dev-B19D4784.key

@@ -0,0 +1,11 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+
+mDMEafMY7xYJKwYBBAHaRw8BAQdAX7Cs0UPcvEpHOwmTDkjNBfeH6/FH6sqKZbRi
+sd3oBCy0U1RyaWJlcyBTdXBlcnRlc3QgRGV2IChBSSBsb2NhbCBkZXZlbG9wbWVu
+dCBrZXkpIDx0cmliZXMtc3VwZXJ0ZXN0LWRldkB0ZXJhbGluay5uZXQ+iJYEExYK
+AD4WIQTym6baluXsKf3e2ZSPT3WzsZ1HhAUCafMY7wIbAwUJAeEzgAULCQgHAgYV
+CgkICwIEFgIDAQIeAQIXgAAKCRCPT3WzsZ1HhMp8AP4gGrPkBoGLKMyubISESFpH
+fnqYUGDGucIoLRvtbl+ULQD/SlC9u/Ek9WSYvsskd0jD09lc2TxBnubl8yRi3bTM
+sA8=
+=JA7U
+-----END PGP PUBLIC KEY BLOCK-----

tests/tribes-deploy-current-guix.scm

@@ -59,12 +59,15 @@
   (let* ((root (fresh-root))
          (home (string-append root "/home"))
          (bin (string-append root "/bin"))
-         (path-guix (string-append bin "/guix")))
+         (path-guix (string-append bin "/guix"))
+         (expected-guix (if (file-exists? system-guix-binary)
+                            system-guix-binary
+                            path-guix)))
     (write-executable path-guix "#!/bin/sh\nexit 0\n")
     (with-env (("HOME" home)
                ("PATH" bin))
-      (test-equal "current-guix-binary falls back to guix on PATH"
-        path-guix
+      (test-equal "current-guix-binary falls back after pulled profile"
+        expected-guix
         (current-guix-binary))))
 
   (with-env (("GUILE_LOAD_PATH" "bad-load")
@@ -86,7 +89,7 @@
               (getenv "GUIX_PACKAGE_PATH")))))
 
   (let* ((root (fresh-root))
-         (profile (string-append root "/profile"))
+         (profile (string-append root "/.config/guix/current"))
          (guix (string-append profile "/bin/guix"))
          (module (string-append profile
                                 "/share/guile/site/3.0/tribes/example.scm")))
@@ -94,7 +97,7 @@
     (mkdir-p (dirname module))
     (call-with-output-file module
       (lambda (port) (display ";; fixture\n" port)))
-    (with-env (("HOME" (string-append root "/home"))
+    (with-env (("HOME" root)
                ("PATH" (string-append profile "/bin")))
       (test-equal "current-guix-module-file resolves under selected profile"
         module

tests/tribes-deploy-executor.scm

@@ -1,6 +1,7 @@
 (define-module (tests tribes-deploy-executor)
   #:use-module (srfi srfi-64)
   #:use-module (tribes deploy executor)
+  #:use-module (tribes deploy plan)
   #:export (run-tests))
 
 (define valid-signer
@@ -66,6 +67,19 @@
                      (("plugin_name" . "disabled")
                       ("enabled" . #f)))))))
 
+  (test-assert "legacy plans without resolved channel metadata still pull"
+    (plan-requires-pull? '(("plan_hash" . "legacy"))))
+
+  (test-assert "plans with an explicit empty channel delta skip pull"
+    (not (plan-requires-pull?
+          '(("plan_hash" . "plugin-only")
+            ("resolved_channels" . #())))))
+
+  (test-assert "plans with resolved channel changes still pull"
+    (plan-requires-pull?
+     '(("plan_hash" . "channel-update")
+       ("resolved_channels" . #((("name" . "guix-tribes")))))))
+
   (test-equal "resolve-target emits channel-aware plugin package refs"
     '("aether")
     (let* ((plan (resolve-target valid-target))
@@ -79,6 +93,15 @@
       (test-equal "channel commit is propagated to package ref"
         "abc123"
         (json-ref package-ref "commit"))
+      (let* ((channels (json-ref plan "resolved_channels"))
+             (channel (and (vector? channels) (> (vector-length channels) 0)
+                           (vector-ref channels 0))))
+        (test-equal "channel branch is preserved in resolved plan"
+          "main"
+          (json-ref channel "branch"))
+        (test-equal "channel introduction is preserved in resolved plan"
+          "intro123"
+          (json-ref (json-ref channel "introduction") "commit")))
       (test-equal "registry version is used"
         "0.1.0"
         (json-ref package-ref "version"))

tests/tribes-deploy-operations.scm

@@ -1,5 +1,6 @@
 (define-module (tests tribes-deploy-operations)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 textual-ports)
   #:use-module (guix build utils)
   #:use-module (json)
   #:use-module (srfi srfi-1)
@@ -10,6 +11,7 @@
   #:use-module (tribes deploy guix-helper)
   #:use-module (tribes deploy json)
   #:use-module (tribes deploy operations)
+  #:use-module (tribes deploy plan)
   #:use-module (tribes deploy state)
   #:export (run-tests))
 
@@ -23,6 +25,22 @@
   '(("plan_hash" . "plan-b")
     ("resolved_plugins" . ((("name" . "aether"))))))
 
+(define plan-without-channel-delta
+  '(("plan_hash" . "plan-without-channel-delta")
+    ("resolved_channels" . #())
+    ("resolved_plugins" . ((("name" . "supertest"))))))
+
+(define plan-with-channel-delta
+  '(("plan_hash" . "plan-with-channel-delta")
+    ("resolved_channels" . #((("channel_id" . "guix-tribes")
+                               ("url" . "https://git.example.test/guix-tribes.git")
+                               ("branch" . "dev")
+                               ("commit" . "abc123")
+                               ("introduction" . (("commit" . "intro123")
+                                                  ("fingerprint" . "0123456789ABCDEF0123456789ABCDEF01234567")))
+                               ("position" . 0))))
+    ("resolved_plugins" . ((("name" . "supertest"))))))
+
 (define (delete-if-present path)
   (when (false-if-exception (lstat path))
     (delete-file path)))
@@ -108,6 +126,9 @@
     (lambda (port)
       (scm->json (json-ready payload) port))))
 
+(define (read-text-file path)
+  (call-with-input-file path get-string-all))
+
 (define (make-fixture)
   (let* ((root (fresh-root))
          (deploy-directory (string-append root "/deploy"))
@@ -158,6 +179,25 @@
 
 (define (no-frame _) #t)
 
+(define rollback-herd-command
+  (@@ (tribes deploy operations) rollback-herd-command))
+
+(define (write-executable path content)
+  (call-with-output-file path
+    (lambda (port) (display content port)))
+  (chmod path #o755))
+
+(define (with-fake-rollback-herd fixture thunk)
+  (let* ((herd (string-append (assq-ref fixture 'root) "/fake-herd"))
+         (log-file (string-append (assq-ref fixture 'root) "/herd.log")))
+    (write-executable
+     herd
+     (string-append "#!/bin/sh\n"
+                    "printf '%s\\n' \"$*\" >> " log-file "\n"
+                    "exit 0\n"))
+    (parameterize ((rollback-herd-command herd))
+      (thunk))))
+
 (define (find-generation-by-plan-hash generations plan-hash)
   (find (lambda (generation)
           (equal? (json-ref generation "plan_hash") plan-hash))
@@ -219,24 +259,76 @@
          (state (make-state-store (fixture->config fixture))))
     (call-with-values (lambda () (make-fake-helper fixture))
       (lambda (helper get-builds get-pulls get-switches)
-        (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
-                                             (plan-hash plan-a) no-frame))
-               (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
-               (_pb (prepare-plugins! state helper (plan-plugins plan-b)
-                                      (plan-hash plan-b) no-frame))
-               (_cb (commit-plan! state helper (plan-hash plan-b) no-frame))
-               (rollback (rollback-store-path! state helper
-                                               (json-ref prepared-a "store_path")
-                                               #f no-frame)))
-          (test-equal "direct rollback succeeds for retained generation"
-            "healthy" (json-ref rollback "status"))
-          (test-equal "direct rollback does not rebuild"
-            2 (get-builds))
-          (test-equal "direct rollback performs a third switch"
-            3 (get-switches))
-          (test-equal "rolled back system points at prior store path"
-            (json-ref prepared-a "store_path")
-            (state-store-running-system-path state))))))
+        (let ((prepared (prepare-plugins! state helper
+                                          (plan-plugins plan-without-channel-delta)
+                                          (plan-hash plan-without-channel-delta)
+                                          no-frame
+                                          #:pull-required?
+                                          (plan-requires-pull?
+                                           plan-without-channel-delta))))
+          (test-equal "prepare skips pull for plans with no channel delta"
+            "ready"
+            (json-ref prepared "status"))
+          (test-equal "no-channel-delta prepare does not pull"
+            0 (get-pulls))
+          (test-equal "no-channel-delta prepare still builds"
+            1 (get-builds))
+          (test-equal "no-channel-delta prepare does not switch"
+            0 (get-switches))))))
+
+  (let* ((fixture (make-fixture))
+         (state (make-state-store (fixture->config fixture)))
+         (channels-file (assq-ref fixture 'channels-file)))
+    (call-with-output-file channels-file
+      (lambda (port)
+        (display "(list\n  (channel\n    (name 'guix)\n    (url \"https://git.example.test/guix.git\")\n    (branch \"master\")\n    (commit \"guix-commit\")))\n" port)))
+    (call-with-values (lambda () (make-fake-helper fixture))
+      (lambda (helper get-builds get-pulls get-switches)
+        (let* ((_prepared (prepare-plugins! state helper
+                                            (plan-plugins plan-with-channel-delta)
+                                            (plan-hash plan-with-channel-delta)
+                                            no-frame
+                                            #:plan plan-with-channel-delta
+                                            #:pull-required?
+                                            (plan-requires-pull?
+                                             plan-with-channel-delta)))
+               (channels-text (read-text-file channels-file)))
+          (test-assert "prepare preserves base guix channel"
+            (string-contains channels-text "guix-commit"))
+          (test-assert "prepare writes rollout channel branch"
+            (string-contains channels-text "(branch \"dev\")"))
+          (test-assert "prepare writes rollout channel commit"
+            (string-contains channels-text "(commit \"abc123\")"))
+          (test-assert "prepare writes rollout channel introduction"
+            (string-contains channels-text "intro123"))
+          (test-equal "channel-delta prepare pulls"
+            1 (get-pulls))))))
+
+  (let* ((fixture (make-fixture))
+         (state (make-state-store (fixture->config fixture))))
+    (with-fake-rollback-herd
+     fixture
+     (lambda ()
+       (call-with-values (lambda () (make-fake-helper fixture))
+         (lambda (helper get-builds get-pulls get-switches)
+           (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
+                                                (plan-hash plan-a) no-frame))
+                  (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
+                  (_pb (prepare-plugins! state helper (plan-plugins plan-b)
+                                         (plan-hash plan-b) no-frame))
+                  (_cb (commit-plan! state helper (plan-hash plan-b) no-frame))
+                  (rollback (rollback-store-path! state helper
+                                                  (json-ref prepared-a "store_path")
+                                                  #f no-frame)))
+             (test-equal "direct rollback succeeds for retained generation"
+               "healthy" (json-ref rollback "status"))
+             (test-equal "direct rollback does not rebuild"
+               2 (get-builds))
+             (test-equal "direct rollback performs a third switch"
+               3 (get-switches))
+             (test-equal "rolled back system points at prior store path"
+               (json-ref prepared-a "store_path")
+               (state-store-running-system-path state))))))))
 
   (let* ((fixture (make-fixture))
          (state (make-state-store (fixture->config fixture)))
@@ -251,67 +343,76 @@
     (symlink (string-append (assq-ref fixture 'profiles-directory)
                             "/system-1-link")
              current-system-link)
-    (call-with-values (lambda () (make-fake-helper fixture))
-      (lambda (helper get-builds get-pulls get-switches)
-        (let* ((_prepared (prepare-plugins! state helper (plan-plugins plan-a)
-                                            (plan-hash plan-a) no-frame))
-               (_commit (commit-plan! state helper (plan-hash plan-a) no-frame))
-               (rollback (rollback-store-path! state helper baseline-store-path
-                                               #f no-frame)))
-          (test-equal "rollback can switch to an unrecorded Guix profile generation"
-            "healthy" (json-ref rollback "status"))
-          (test-equal "profile-generation rollback does not rebuild"
-            1 (get-builds))
-          (test-equal "profile-generation rollback performs the second switch"
-            2 (get-switches))
-          (test-equal "profile-generation rollback returns to the baseline store path"
-            baseline-store-path
-            (state-store-running-system-path state))))))
+    (with-fake-rollback-herd
+     fixture
+     (lambda ()
+       (call-with-values (lambda () (make-fake-helper fixture))
+         (lambda (helper get-builds get-pulls get-switches)
+           (let* ((_prepared (prepare-plugins! state helper (plan-plugins plan-a)
+                                               (plan-hash plan-a) no-frame))
+                  (_commit (commit-plan! state helper (plan-hash plan-a) no-frame))
+                  (rollback (rollback-store-path! state helper baseline-store-path
+                                                  #f no-frame)))
+             (test-equal "rollback can switch to an unrecorded Guix profile generation"
+               "healthy" (json-ref rollback "status"))
+             (test-equal "profile-generation rollback does not rebuild"
+               1 (get-builds))
+             (test-equal "profile-generation rollback performs the second switch"
+               2 (get-switches))
+             (test-equal "profile-generation rollback returns to the baseline store path"
+               baseline-store-path
+               (state-store-running-system-path state))))))))
 
   (let* ((fixture (make-fixture))
          (state (make-state-store (fixture->config fixture))))
-    (call-with-values (lambda () (make-fake-helper fixture))
-      (lambda (helper get-builds get-pulls get-switches)
-        (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
-                                             (plan-hash plan-a) no-frame))
-               (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
-               (_pb (prepare-plugins! state helper (plan-plugins plan-b)
-                                      (plan-hash plan-b) no-frame))
-               (_cb (commit-plan! state helper (plan-hash plan-b) no-frame))
-               (_drop (delete-directory-if-present
-                       (json-ref prepared-a "store_path")))
-               (rollback (rollback-store-path! state helper
-                                               (json-ref prepared-a "store_path")
-                                               plan-a no-frame))
-               (generation-a (find-generation-by-plan-hash
-                              (state-store-read-generations state)
-                              (plan-hash plan-a))))
-          (test-equal "rollback rebuilds from plan when store path is gone"
-            "healthy" (json-ref rollback "status"))
-          (test-equal "rebuild fallback performs a third build"
-            3 (get-builds))
-          (test-equal "rebuild fallback performs a third switch"
-            3 (get-switches))
-          (test-assert "rebuild fallback records a new active generation"
-            (> (json-ref generation-a "generation_number") 1))
-          (test-assert "rebuild fallback activates a new store path"
-            (not (string=? (state-store-running-system-path state)
-                           (json-ref prepared-a "store_path"))))))))
+    (with-fake-rollback-herd
+     fixture
+     (lambda ()
+       (call-with-values (lambda () (make-fake-helper fixture))
+         (lambda (helper get-builds get-pulls get-switches)
+           (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
+                                                (plan-hash plan-a) no-frame))
+                  (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
+                  (_pb (prepare-plugins! state helper (plan-plugins plan-b)
+                                         (plan-hash plan-b) no-frame))
+                  (_cb (commit-plan! state helper (plan-hash plan-b) no-frame))
+                  (_drop (delete-directory-if-present
+                          (json-ref prepared-a "store_path")))
+                  (rollback (rollback-store-path! state helper
+                                                  (json-ref prepared-a "store_path")
+                                                  plan-a no-frame))
+                  (generation-a (find-generation-by-plan-hash
+                                 (state-store-read-generations state)
+                                 (plan-hash plan-a))))
+             (test-equal "rollback rebuilds from plan when store path is gone"
+               "healthy" (json-ref rollback "status"))
+             (test-equal "rebuild fallback performs a third build"
+               3 (get-builds))
+             (test-equal "rebuild fallback performs a third switch"
+               3 (get-switches))
+             (test-assert "rebuild fallback records a new active generation"
+               (> (json-ref generation-a "generation_number") 1))
+             (test-assert "rebuild fallback activates a new store path"
+               (not (string=? (state-store-running-system-path state)
+                              (json-ref prepared-a "store_path"))))))))))
 
   (let* ((fixture (make-fixture))
          (state (make-state-store (fixture->config fixture))))
-    (call-with-values (lambda () (make-fake-helper fixture))
-      (lambda (helper get-builds get-pulls get-switches)
-        (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
-                                             (plan-hash plan-a) no-frame))
-               (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
-               (_drop (delete-directory-if-present
-                       (json-ref prepared-a "store_path")))
-               (rollback (rollback-store-path! state helper
-                                               (json-ref prepared-a "store_path")
-                                               #f no-frame)))
-          (test-equal "rollback without a retained store path or plan is infeasible"
-            "rollback_infeasible" (json-ref rollback "code"))))))
+    (with-fake-rollback-herd
+     fixture
+     (lambda ()
+       (call-with-values (lambda () (make-fake-helper fixture))
+         (lambda (helper get-builds get-pulls get-switches)
+           (let* ((prepared-a (prepare-plugins! state helper (plan-plugins plan-a)
+                                                (plan-hash plan-a) no-frame))
+                  (_ca (commit-plan! state helper (plan-hash plan-a) no-frame))
+                  (_drop (delete-directory-if-present
+                          (json-ref prepared-a "store_path")))
+                  (rollback (rollback-store-path! state helper
+                                                  (json-ref prepared-a "store_path")
+                                                  #f no-frame)))
+             (test-equal "rollback without a retained store path or plan is infeasible"
+               "rollback_infeasible" (json-ref rollback "code"))))))))
 
   (let* ((fixture (make-fixture))
          (state (make-state-store (fixture->config fixture)))

tests/tribes-diagnostics-system-generations.scm

@@ -1,11 +1,18 @@
 (define-module (tests tribes-diagnostics-system-generations)
+  #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-64)
   #:use-module (tribes diagnostics system-generations)
   #:export (run-tests))
 
+(define emit-json
+  (@@ (tribes diagnostics system-generations) emit-json))
+
 (define system-reference-section
   (@@ (tribes diagnostics system-generations) system-reference-section))
 
+(define service-diff
+  (@@ (tribes diagnostics system-generations) service-diff))
+
 (define path->store-item
   (@@ (tribes diagnostics system-generations) path->store-item))
 
@@ -50,6 +57,19 @@
       (test-assert "non-store profile subpaths skip closure refs too"
         (equal? (json-ref closure "skipped") #t))))
 
+  (let* ((service '(("name" . "console-font-tty1")
+                    ("provisions" . ("console-font-tty1"))
+                    ("requirements" . ())
+                    ("oneShot" . #t)
+                    ("autoStart" . #t)
+                    ("file" . "/gnu/store/00000000000000000000000000000000-console-font")))
+         (report `(("services" . ,(service-diff (list service) (list service)))))
+         (output (with-output-to-string
+                   (lambda ()
+                     (emit-json report #t)))))
+    (test-assert "pretty JSON handles unchanged service arrays"
+      (string-contains output "\"unchanged\"")))
+
   (test-end "tribes-diagnostics-system-generations"))
 
 (run-tests)

tribes/deploy/cli.scm

@@ -68,7 +68,9 @@
                         #:plan-hash plan-hash-value))
       (exit 1))
     (let ((payload (prepare-plugins! state helper plugins
-                                     plan-hash-value no-frame)))
+                                     plan-hash-value no-frame
+                                     #:pull-required?
+                                     (plan-requires-pull? plan))))
       (json-print payload)
       (unless (equal? (json-ref payload "ok") #t) (exit 1)))))
 

tribes/deploy/executor.scm

@@ -57,6 +57,9 @@
 (define (channel-commit channel)
   (or (json-ref channel "commit") ""))
 
+(define (channel-branch channel)
+  (or (json-ref channel "branch") "master"))
+
 (define (channel-position channel)
   (let ((value (json-ref channel "position")))
     (if (integer? value) value 0)))
@@ -115,7 +118,9 @@
 (define (channel->resolved channel)
   `(("channel_id" . ,(channel-id channel))
     ("url" . ,(channel-url channel))
+    ("branch" . ,(channel-branch channel))
     ("commit" . ,(channel-commit channel))
+    ("introduction" . ,(channel-introduction channel))
     ("position" . ,(channel-position channel))))
 
 (define (default-plugin-channel channels)

tribes/deploy/handlers.scm

@@ -115,7 +115,10 @@
      (else
       (let ((plugins (plan-plugins payload))
             (plan-hash-value (plan-hash payload)))
-        (submit-prepare! state worker helper plugins plan-hash-value))))))
+        (submit-prepare! state worker helper plugins plan-hash-value
+                         #:plan payload
+                         #:pull-required?
+                         (plan-requires-pull? payload)))))))
 
 (define (handle-commit state worker helper payload)
   (let ((err (validate-commit-input payload)))

tribes/deploy/operations.scm

@@ -134,13 +134,101 @@
          (updated (host-config-with-plugins host-config plugins)))
     (atomic-write-json-file host-config-file updated)))
 
+(define (resolved-channel-url channel)
+  (or (json-ref channel "url") ""))
+
+(define (resolved-channel-branch channel)
+  (or (json-ref channel "branch") "master"))
+
+(define (resolved-channel-commit channel)
+  (or (json-ref channel "commit") ""))
+
+(define (resolved-channel-introduction channel)
+  (let ((value (json-ref channel "introduction")))
+    (if (json-object? value) value '())))
+
+(define (guix-channel-name channel)
+  'tribes)
+
+(define (channel-form-name form)
+  (match form
+    (('channel fields ...)
+     (match (find (lambda (field)
+                    (and (pair? field) (eq? (car field) 'name)))
+                  fields)
+       (('name ('quote name)) name)
+       (('name name) name)
+       (_ #f)))
+    (_ #f)))
+
+(define (existing-base-channel-forms channels-file)
+  (if (file-exists? channels-file)
+      (let ((form (false-if-exception
+                   (call-with-input-file channels-file read))))
+        (match form
+          (('list forms ...)
+           (filter (lambda (form)
+                     (not (eq? (channel-form-name form) 'tribes)))
+                   forms))
+          (_ '())))
+      '()))
+
+(define (write-scheme-string port value)
+  (write (or value "") port))
+
+(define (write-channel-introduction port introduction)
+  (let ((commit (json-ref introduction "commit"))
+        (fingerprint (json-ref introduction "fingerprint")))
+    (when (and (string? commit) (string? fingerprint))
+      (display "\n    (introduction\n      (make-channel-introduction\n        " port)
+      (write-scheme-string port commit)
+      (display "\n        (openpgp-fingerprint\n          " port)
+      (write-scheme-string port fingerprint)
+      (display ")))" port))))
+
+(define (write-channel port channel)
+  (let ((commit (resolved-channel-commit channel))
+        (introduction (resolved-channel-introduction channel)))
+    (display "  (channel\n    (name '" port)
+    (display (guix-channel-name channel) port)
+    (display ")\n    (url " port)
+    (write-scheme-string port (resolved-channel-url channel))
+    (display ")\n    (branch " port)
+    (write-scheme-string port (resolved-channel-branch channel))
+    (display ")" port)
+    (unless (string=? commit "")
+      (display "\n    (commit " port)
+      (write-scheme-string port commit)
+      (display ")" port))
+    (write-channel-introduction port introduction)
+    (display ")\n" port)))
+
+(define (write-plan-channels! config plan)
+  (let ((channels (plan-resolved-channels plan)))
+    (when (and channels (not (null? channels)))
+      (let* ((channels-file (deploy-config-channels-file config))
+             (base-forms (existing-base-channel-forms channels-file)))
+        (call-with-output-file channels-file
+          (lambda (port)
+            (display "(list\n" port)
+            (for-each
+             (lambda (form)
+               (display "  " port)
+               (write form port)
+               (newline port))
+             base-forms)
+            (for-each (lambda (channel) (write-channel port channel)) channels)
+            (display ")\n" port)))))))
+
 (define (selected-system-path state)
   (state-store-selected-system-path state))
 
 (define (running-system-path state)
   (state-store-running-system-path state))
 
-(define (prepare-plugins! state helper plugins plan-hash-value on-frame)
+(define* (prepare-plugins! state helper plugins plan-hash-value on-frame
+                           #:key plan
+                           (pull-required? #t))
   (let* ((cfg (state-store-config state))
          (existing (state-store-find-generation-by-plan-hash state plan-hash-value)))
     (state-store-write-status! state "running"
@@ -148,6 +236,8 @@
                                #:plan-hash plan-hash-value
                                #:phase "running")
     (record-host-config-update! state plugins)
+    (when plan
+      (write-plan-channels! cfg plan))
     (cond
      ;; Idempotency: if we already built this plan and the store path still
      ;; exists, just re-register the GC root and report ready.
@@ -169,10 +259,14 @@
                          #:selected-system (selected-system-path state)
                          #:running-system (running-system-path state))))
      (else
-      (on-frame `(("event" . "phase") ("phase" . "pulling")))
-      (let ((pull-result ((helper-backend-pull helper) cfg on-frame)))
+      (let ((pull-result
+             (if pull-required?
+                 (begin
+                   (on-frame `(("event" . "phase") ("phase" . "pulling")))
+                   ((helper-backend-pull helper) cfg on-frame))
+                 #f)))
         (cond
-         ((not (helper-result-ok? pull-result))
+         ((and pull-result (not (helper-result-ok? pull-result)))
           (state-store-write-status! state "failed"
                                      #:ok #f
                                      #:plugins plugins
@@ -221,7 +315,8 @@
                                                     "ready"
                                                     #:generation-number gen-number
                                                     #:built-at #f
-                                                    #:gc-pinned #t)
+                                                    #:gc-pinned #t
+                                                    #:plugins plugins)
                     (state-store-write-status! state "completed"
                                                #:plugins plugins
                                                #:plan-hash plan-hash-value
@@ -276,7 +371,9 @@
                                             active-generation-number
                                             #:built-at (json-ref existing "built_at")
                                             #:activated-at #f
-                                            #:gc-pinned #t)
+                                            #:gc-pinned #t
+                                            #:plugins
+                                            (or (json-string-list-ref existing "plugins") '()))
             (state-store-activate-generation! state selected-store-path)
             (state-store-write-status! state "completed"
                                        #:plan-hash plan-hash-value
@@ -299,6 +396,23 @@
 ;;  2. We have a recorded generation number → switch to it.
 ;;  3. We have a plan to rebuild from → recurse via prepare+commit.
 
+(define system-herd "/run/current-system/profile/bin/herd")
+
+(define rollback-herd-command (make-parameter #f))
+
+(define (current-herd-command)
+  (or (rollback-herd-command)
+      (if (file-exists? system-herd) system-herd "herd")))
+
+(define (rollback-plugin-migrations!)
+  ;; Rollback is destructive by definition for plugin uninstall/downgrade in
+  ;; pre-release Tribes. Stop the app first so plugin code is not touching tables
+  ;; while release helpers run down migrations from the currently selected
+  ;; generation, then let the subsequent system switch restart the target app.
+  (let ((herd (current-herd-command)))
+    (system* herd "stop" "tribes")
+    (zero? (system* herd "start" "tribes-plugin-rollback-migrations"))))
+
 (define (rollback-store-path! state helper store-path maybe-plan on-frame)
   (let ((cfg (state-store-config state))
         (selected-system (selected-system-path state))
@@ -325,49 +439,56 @@
                        #:selected-system store-path
                        #:running-system (running-system-path state)))
      ((and generation (integer? (json-ref generation "generation_number")))
-      (let* ((gen-number (json-ref generation "generation_number"))
-             (switch-result ((helper-backend-switch helper) cfg gen-number on-frame)))
-        (cond
-         ((helper-result-ok? switch-result)
-          (let* ((active-store-path
-                  (let ((path (selected-system-path state)))
-                    (if (and (string? path)
-                             (not (string=? path "unknown")))
-                        path
-                        store-path)))
-                 (running-store-path (running-system-path state))
-                 (active-generation-number
-                  (or (state-store-current-generation-number state)
-                      (json-ref generation "generation_number"))))
-            (state-store-record-generation! state active-store-path
-                                            (or (json-ref generation "plan_hash") "")
-                                            "active"
-                                            #:generation-number
-                                            active-generation-number
-                                            #:built-at (json-ref generation "built_at")
-                                            #:activated-at #f
-                                            #:gc-pinned #t)
-            (state-store-activate-generation! state active-store-path)
-            (state-store-write-status! state "completed"
-                                       #:store-path active-store-path
-                                       #:selected-system active-store-path
-                                       #:running-system running-store-path
-                                       #:plan-hash (json-ref generation "plan_hash")
-                                       #:generation-number active-generation-number
-                                       #:phase "active")
-            (success-payload "healthy" active-store-path
-                             (or (json-ref generation "plan_hash") "")
-                             active-generation-number
-                             #t
-                             #:activated-at #f
-                             #:selected-system active-store-path
-                             #:running-system running-store-path)))
-         (maybe-plan
-          (rollback-with-plan state helper maybe-plan on-frame))
-         (else
-          (failure-payload "rollback_infeasible"
-                           #:code "rollback_infeasible"
-                           #:store-path store-path)))))
+      (if (not (rollback-plugin-migrations!))
+          (failure-payload "plugin_migration_rollback_failed"
+                           #:code "plugin_migration_rollback_failed"
+                           #:store-path store-path)
+          (let* ((target-plugins (or (json-string-list-ref generation "plugins") '()))
+                 (_ (record-host-config-update! state target-plugins))
+                 (gen-number (json-ref generation "generation_number"))
+                 (switch-result ((helper-backend-switch helper) cfg gen-number on-frame)))
+            (cond
+             ((helper-result-ok? switch-result)
+              (let* ((active-store-path
+                      (let ((path (selected-system-path state)))
+                        (if (and (string? path)
+                                 (not (string=? path "unknown")))
+                            path
+                            store-path)))
+                     (running-store-path (running-system-path state))
+                     (active-generation-number
+                      (or (state-store-current-generation-number state)
+                          (json-ref generation "generation_number"))))
+                (state-store-record-generation! state active-store-path
+                                                (or (json-ref generation "plan_hash") "")
+                                                "active"
+                                                #:generation-number
+                                                active-generation-number
+                                                #:built-at (json-ref generation "built_at")
+                                                #:activated-at #f
+                                                #:gc-pinned #t
+                                                #:plugins target-plugins)
+                (state-store-activate-generation! state active-store-path)
+                (state-store-write-status! state "completed"
+                                           #:store-path active-store-path
+                                           #:selected-system active-store-path
+                                           #:running-system running-store-path
+                                           #:plan-hash (json-ref generation "plan_hash")
+                                           #:generation-number active-generation-number
+                                           #:phase "active")
+                (success-payload "healthy" active-store-path
+                                 (or (json-ref generation "plan_hash") "")
+                                 active-generation-number
+                                 #t
+                                 #:activated-at #f
+                                 #:selected-system active-store-path
+                                 #:running-system running-store-path)))
+             (maybe-plan
+              (rollback-with-plan state helper maybe-plan on-frame))
+             (else
+              (failure-payload "rollback_infeasible"
+                               #:code "rollback_infeasible"
+                               #:store-path store-path))))))
      (maybe-plan
       (rollback-with-plan state helper maybe-plan on-frame))
      (else
@@ -378,7 +499,10 @@
 (define (rollback-with-plan state helper plan on-frame)
   (let* ((plan-hash-value (plan-hash plan))
          (prepared (prepare-plugins! state helper (plan-plugins plan)
-                                     plan-hash-value on-frame)))
+                                     plan-hash-value on-frame
+                                     #:plan plan
+                                     #:pull-required?
+                                     (plan-requires-pull? plan))))
     (if (equal? (json-ref prepared "ok") #t)
         (commit-plan! state helper plan-hash-value on-frame)
         prepared)))
@@ -404,7 +528,9 @@
                 (not (member (car e) '("schemaVersion" "status" "ok"))))
               snapshot)))
 
-(define (submit-prepare! state worker helper plugins plan-hash-value)
+(define* (submit-prepare! state worker helper plugins plan-hash-value
+                          #:key plan
+                          (pull-required? #t))
   (call-with-values
       (lambda ()
         (worker-submit!
@@ -416,7 +542,9 @@
                       (update! phase)))))
              (%make-job-result-from-payload
               (prepare-plugins! state helper plugins
-                                plan-hash-value on-frame))))))
+                                plan-hash-value on-frame
+                                #:plan plan
+                                #:pull-required? pull-required?))))))
     (lambda (status snapshot)
       (case status
         ((accepted idempotent)

tribes/deploy/plan.scm

@@ -11,6 +11,8 @@
             host-config-with-plugins
             system-target-plugin-names
             plan-plugins
+            plan-resolved-channels
+            plan-requires-pull?
             plan-hash
             string-plan-hash))
 
@@ -99,6 +101,15 @@
       resolved)
      string<?)))
 
+(define (plan-resolved-channels plan)
+  (or (json-list-ref plan "resolved_channels")
+      (json-list-ref plan "resolvedChannels")))
+
+(define (plan-requires-pull? plan)
+  (let ((channels (plan-resolved-channels plan)))
+    (or (not channels)
+        (not (null? channels)))))
+
 (define (canonical-json-string value)
   (call-with-output-string
    (lambda (port)

tribes/deploy/state.scm

@@ -290,7 +290,8 @@ predate the local-control deployment state and therefore may not appear in
                                          generation-number
                                          built-at
                                          activated-at
-                                         (gc-pinned #t))
+                                         (gc-pinned #t)
+                                         (plugins #f))
   (let ((generation
          `(("store_path" . ,store-path)
            ("generation_number" . ,generation-number)
@@ -298,7 +299,8 @@ predate the local-control deployment state and therefore may not appear in
            ("status" . ,generation-status)
            ("gc_pinned" . ,gc-pinned)
            ("built_at" . ,built-at)
-           ("activated_at" . ,activated-at))))
+           ("activated_at" . ,activated-at)
+           ,@(if plugins `(("plugins" . ,plugins)) '()))))
     (state-store-upsert-generation! store generation)
     (when (string=? generation-status "active")
       (state-store-activate-generation! store store-path))

tribes/diagnostics/system-generations.scm

@@ -32,7 +32,12 @@
   (exit 1))
 
 (define (json-object? value)
-  (and (list? value) (every pair? value)))
+  (and (list? value)
+       (every (lambda (entry)
+                (and (pair? entry)
+                     (or (string? (car entry))
+                         (symbol? (car entry)))))
+              value)))
 
 (define (json-ref object key)
   (and (json-object? object)
@@ -45,14 +50,14 @@
    ((boolean? value) value)
    ((number? value) value)
    ((string? value) value)
-   ((null? value) '())
+   ((null? value) #())
    ((vector? value) (list->vector (map stringify (vector->list value))))
    ((json-object? value)
     (map (lambda (entry)
            (cons (stringify (car entry))
                  (stringify (cdr entry))))
          value))
-   ((pair? value) (map stringify value))
+   ((pair? value) (list->vector (map stringify value)))
    (else (format #f "~a" value))))
 
 (define (emit-json payload pretty?)

tribes/packages/mix.scm

@@ -43,15 +43,15 @@ SOURCE according to mix.lock."
          (define cert-file
            (string-append work "/ca-certificates.crt"))
          (define hex-lib-dir
-           #$(file-append elixir-hex-otp28
-                          "/lib/elixir/"
-                          (version-major+minor
-                           (package-version elixir-otp28))))
+           (string-append
+            #$(file-append elixir-hex-otp28 "/lib/elixir/1.19")
+            ":"
+            #$(file-append elixir-hex-otp28 "/lib/elixir/1.18")))
          (define path
            (string-join
             (list #$(file-append elixir-otp28 "/bin")
                   #$(file-append elixir-hex-otp28 "/bin")
-                  #$(file-append rebar3 "/bin")
+                  #$(file-append rebar3-otp28 "/bin")
                   #$(file-append bash-minimal "/bin")
                   #$(file-append coreutils "/bin")
                   #$(file-append findutils "/bin")
@@ -82,7 +82,7 @@ SOURCE according to mix.lock."
          (setenv "MIX_ENV" #$mix-env)
          (setenv "MIX_TARGET" #$mix-target)
          (setenv "MIX_OS_CONCURRENCY_LOCK" "0")
-         (setenv "MIX_REBAR3" #$(file-append rebar3 "/bin/rebar3"))
+         (setenv "MIX_REBAR3" #$(file-append rebar3-otp28 "/bin/rebar3"))
          (setenv "REBAR_GLOBAL_CONFIG_DIR" (string-append work "/rebar3"))
          (setenv "REBAR_CACHE_DIR" (string-append work "/rebar3.cache"))
          (setenv "LANG" "C.UTF-8")
@@ -264,17 +264,17 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
               (define cert-file
                 (string-append work "/ca-certificates.crt"))
               (define hex-lib-dir
-                #$(file-append elixir-hex-otp28
-                               "/lib/elixir/"
-                               (version-major+minor
-                                (package-version elixir-otp28))))
+                (string-append
+                 #$(file-append elixir-hex-otp28 "/lib/elixir/1.19")
+                 ":"
+                 #$(file-append elixir-hex-otp28 "/lib/elixir/1.18")))
               (define aclocal-path
                 (string-join (list #$@aclocal-dirs) ":"))
               (define path
                 (string-join
                  (list #$(file-append elixir-otp28 "/bin")
                        #$(file-append elixir-hex-otp28 "/bin")
-                       #$(file-append rebar3 "/bin")
+                       #$(file-append rebar3-otp28 "/bin")
                        #$(file-append bash-minimal "/bin")
                        #$(file-append coreutils "/bin")
                        #$(file-append findutils "/bin")
@@ -315,8 +315,8 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
               (setenv "MIX_OS_CONCURRENCY_LOCK" "0")
               (setenv "MIX_OS_DEPS_COMPILE_PARTITION_COUNT" "4")
               (setenv "HEX_OFFLINE" "1")
-              (setenv "MIX_REBAR" #$(file-append rebar3 "/bin/rebar3"))
-              (setenv "MIX_REBAR3" #$(file-append rebar3 "/bin/rebar3"))
+              (setenv "MIX_REBAR" #$(file-append rebar3-otp28 "/bin/rebar3"))
+              (setenv "MIX_REBAR3" #$(file-append rebar3-otp28 "/bin/rebar3"))
               (setenv "REBAR_GLOBAL_CONFIG_DIR" (string-append work "/rebar3"))
               (setenv "REBAR_CACHE_DIR" (string-append work "/rebar3.cache"))
               (setenv "SHELL" #$(file-append bash-minimal "/bin/sh"))
@@ -371,7 +371,7 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
               findutils
               git-minimal
               nss-certs
-              rebar3
+              rebar3-otp28
               elixir-otp28
               elixir-hex-otp28)
         native-inputs))

tribes/packages/otp.scm

@@ -9,7 +9,9 @@
   #:use-module (gnu packages erlang)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages version-control)
+  #:use-module (srfi srfi-1)
   #:export (erlang-28
+            rebar3-otp28
             elixir-otp28
             elixir-hex-otp28))
 
@@ -29,6 +31,22 @@
         (base32
          "1lsbmjfraw03d0kcdzmjdjad8b95d630d1jmg8hjklmivc13l6pa"))
        (patches (search-patches "erlang-man-path.patch"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments erlang)
+       ((#:configure-flags flags)
+        `(append
+          (map (lambda (flag)
+                 (if (string=? flag "--enable-wx")
+                     "--without-wx"
+                     flag))
+               ,flags)
+          ;; OTP does not automatically skip applications that depend on wx.
+          '("--without-debugger"
+            "--without-observer"
+            "--without-et"
+            "--without-reltool")))))
+    (inputs
+     (alist-delete "wxwidgets" (package-inputs erlang)))
     (native-inputs
      `(("perl" ,perl)
        ("erlang-manpages"
@@ -41,6 +59,14 @@
             (base32
              "00simi301qz3ssn71r77jmsyfz8sb61wp7k92j3gh7pq7gmmc40j"))))))))
 
+(define-public rebar3-otp28
+  (package
+    (inherit rebar3)
+    (name "rebar3-otp28")
+    (native-inputs
+     (modify-inputs (package-native-inputs rebar3)
+       (replace "erlang" erlang-28)))))
+
 (define-public elixir-otp28
   (package
     (inherit elixir)
@@ -65,7 +91,7 @@
     (inputs
      `(("bash-minimal" ,bash-minimal)
        ("erlang" ,erlang-28)
-       ("rebar3" ,rebar3)
+       ("rebar3" ,rebar3-otp28)
        ("git" ,git)))))
 
 (define-public elixir-hex-otp28

tribes/packages/plugins.scm

@@ -1,5 +1,6 @@
 (define-module (tribes packages plugins)
   #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix base32)
   #:use-module (guix build-system trivial)
   #:use-module (guix git-download)
   #:use-module (guix gexp)
@@ -7,6 +8,7 @@
   #:use-module (guix records)
   #:use-module (guix utils)
   #:use-module (gnu packages autotools)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages base)
   #:use-module (gnu packages commencement)
   #:use-module (gnu packages gawk)
@@ -75,6 +77,16 @@
   (or (string=? file root)
       (not (transient-plugin-source-file? root file))))
 
+(define %libsecp256k1-v0.7.1-source
+  (origin
+    (method git-fetch)
+    (uri (git-reference
+          (url "https://github.com/bitcoin-core/secp256k1")
+          (commit "v0.7.1")))
+    (file-name (git-file-name "secp256k1" "0.7.1"))
+    (sha256
+     (base32 "10cvh8jks3rjg6p7y0vm1v4kw9y7vljbfijj0zxwkxzysxx60w0f"))))
+
 (define (plugin-source-directory->local-file directory)
   "Return DIRECTORY as a recursively copied local-file suitable for Guix plugin
 packaging, excluding transient build artifacts and, when possible, files not
@@ -268,35 +280,39 @@ lib/*/ebin."
      #:description description
      #:license license:asl2.0
      #:native-inputs
-     (list autoconf
-           autoconf-wrapper
-           automake
-           gcc-toolchain
-           gawk
-           grep
-           gnu-make
-           libtool
-           linux-libre-headers
-           m4
-           node
-           perl
-           pkg-config
-           sed)
+     (append
+      (list autoconf
+            autoconf-wrapper
+            automake
+            gcc-toolchain
+            diffutils
+            gawk
+            grep
+            gnu-make
+            libtool
+            linux-libre-headers
+            m4
+            perl
+            pkg-config
+            sed)
+      (if build-assets? (list node) '()))
      #:path-inputs
-     (list autoconf
-           autoconf-wrapper
-           automake
-           gcc-toolchain
-           gawk
-           grep
-           gnu-make
-           libtool
-           linux-libre-headers
-           m4
-           node
-           perl
-           pkg-config
-           sed)
+     (append
+      (list autoconf
+            autoconf-wrapper
+            automake
+            gcc-toolchain
+            diffutils
+            gawk
+            grep
+            gnu-make
+            libtool
+            linux-libre-headers
+            m4
+            perl
+            pkg-config
+            sed)
+      (if build-assets? (list node) '()))
      #:aclocal-inputs
      (list automake libtool)
      #:setup-gexp
@@ -319,7 +335,33 @@ lib/*/ebin."
          (setenv "CPP"
                  (string-append #$(file-append gcc-toolchain "/bin/gcc")
                                 " -E"))
-         #$setup-gexp)
+         #$setup-gexp
+         (let* ((libsecp-dep (string-append app-dir "/deps/lib_secp256k1"))
+                (libsecp-c-src (string-append libsecp-dep "/c_src"))
+                (libsecp-source-dir (string-append libsecp-c-src "/secp256k1")))
+           (when (file-exists? libsecp-dep)
+             (mkdir-p libsecp-c-src)
+             (when (file-exists? libsecp-source-dir)
+               (delete-file-recursively libsecp-source-dir))
+             (copy-recursively #+%libsecp256k1-v0.7.1-source
+                               libsecp-source-dir
+                               #:follow-symlinks? #t)
+             (invoke "chmod" "-R" "u+w" libsecp-source-dir)
+             (substitute* (string-append libsecp-source-dir "/autogen.sh")
+               (("^#!.*") (string-append "#!" #$(file-append bash-minimal "/bin/sh") "\n")))
+             (with-directory-excursion libsecp-source-dir
+               (invoke #$(file-append bash-minimal "/bin/sh") "autogen.sh")
+               (invoke #$(file-append bash-minimal "/bin/sh")
+                       "configure"
+                       "--disable-benchmark"
+                       "--disable-tests"
+                       "--disable-fast-install"
+                       "--with-pic"
+                       "--enable-experimental"
+                       "--enable-module-musig"))
+             (call-with-output-file (string-append libsecp-source-dir "/.fetched")
+               (lambda (port)
+                 (display "vendored by guix-tribes\n" port))))))
      #:build-gexp
      #~(begin
          #$resolved-asset-build-gexp

tribes/packages/source.scm

@@ -35,13 +35,13 @@
 ;; from the current Tribes mix.lock, with git metadata stripped except for
 ;; .git/HEAD in SCM dependencies.
 (define %tribes-raw-mix-deps-sha256
-  "0xb64ffi2339771jp9b9hq8742v16qkqrqx6m8lx0a02hq877w2y")
+  "1s7k3qaqnl7lj9jl5xrm9rx0rva23n3az2f99vqjwvibhnhnml0v")
 
 ;; Recursive sha256 of the Tribes-specific prepared deps tree, after injecting
 ;; the upstream secp256k1 source into the Hex package and patching its build
 ;; recipe to avoid build-time network access.
 (define %tribes-mix-deps-sha256
-  "1bbs2i7fwqnl1ihalra17kh9bm34by5c0jma18ksy7cjry70xybi")
+  "1q7p44xdm7xqbrg2z7pa86v8n89a56hlr9c5y31yd4slssb0r8mk")
 
 ;; Recursive sha256 of assets/node_modules generated from assets/package-lock.json
 ;; in an isolated build environment, with local file dependencies resolved from
@@ -53,7 +53,7 @@
   "https://git.teralink.net/tribes/tribes.git")
 
 (define %tribes-commit
-  "96da023db957784d711cbd791ae38dd376351857")
+  "d5d4d62b0f941b74749702c393743d2db009aba2")
 
 (define %tribes-revision "1")
 
@@ -61,7 +61,7 @@
   (git-version "0.2.0" %tribes-revision %tribes-commit))
 
 (define %tribes-source-sha256
-  "063vy13mhil3cnj1nb0ra2r8b5cq286z1ix7didkiifqyb3zdzyi")
+  "1pkl0xpf95n5ravqs1m79084l3nklfwjhsrzihyj1cpm01dfc5np")
 
 (define %tribes-upstream-source
   (origin
@@ -463,6 +463,10 @@ mix.lock and assets/package-lock.json."
          (invoke "mix" "phx.digest"))
      #:install-gexp
      #~(begin
+         (when (file-exists? "plugins/tribes_ui/mix.exs")
+           (with-directory-excursion "plugins/tribes_ui"
+             (invoke "mix" "compile")))
+
          (invoke "mix" "release" "--path" out)
          (let ((launcher (string-append out "/bin/" #$name))
                (launcher-app (string-append out "/bin/" #$name "-app")))
@@ -472,7 +476,17 @@ mix.lock and assets/package-lock.json."
          (when (file-exists? "plugins")
            (copy-recursively "plugins"
                              (string-append out "/plugins")
-                             #:follow-symlinks? #t))))))
+                             #:follow-symlinks? #t))
+
+         (let ((tribes-ui-ebin "_build/prod/lib/tribes_ui/ebin")
+               (tribes-ui-out (string-append out "/plugins/tribes_ui/ebin")))
+           (when (file-exists? tribes-ui-ebin)
+             (when (file-exists? tribes-ui-out)
+               (delete-file-recursively tribes-ui-out))
+             (mkdir-p (dirname tribes-ui-out))
+             (copy-recursively tribes-ui-ebin
+                               tribes-ui-out
+                               #:follow-symlinks? #t)))))))
 
 (define* (local-tribes-package directory
                                #:key

tribes/plugins/registry.scm

@@ -1,6 +1,7 @@
 (define-module (tribes plugins registry)
   #:use-module (tribes packages plugins)
   #:use-module (tribes plugins aether)
+  #:use-module (tribes plugins supertest)
   #:use-module (srfi srfi-1)
   #:export (guix-tribes-plugin-catalog
             guix-tribes-plugin-definition-by-name
@@ -9,7 +10,8 @@
 
 (define guix-tribes-plugin-definitions
   (list
-   (aether-plugin-definition)))
+   (aether-plugin-definition)
+   (supertest-plugin-definition)))
 
 (define guix-tribes-plugin-catalog
   (tribes-plugin-catalog-file guix-tribes-plugin-definitions))

tribes/plugins/supertest.scm

@@ -0,0 +1,106 @@
+(define-module (tribes plugins supertest)
+  #:use-module (guix git-download)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (tribes packages plugins)
+  #:use-module (tribes packages source)
+  #:export (supertest-package
+            supertest-plugin-definition
+            supertest-external-plugin
+            local-supertest-package))
+
+(define %supertest-home-page
+  "https://git.teralink.net/tribes/tribes-plugin-supertest")
+
+(define %supertest-source-url
+  %supertest-home-page)
+
+(define %supertest-commit
+  "c5b2a3b2e70082877d64697a991526f25d8a6671")
+
+(define %supertest-revision "1")
+
+(define %supertest-version
+  (git-version "0.1.1" %supertest-revision %supertest-commit))
+
+(define %supertest-source-sha256
+  "097z65nhvci2r5qk7pb7w75ig9hsw8rplwbv89hi5n6kmqafdhq3")
+
+(define %supertest-mix-deps-sha256
+  "0dacj6c9mhxw37ykksjbhmnsqdhrwpkfsbswm68d2wvcwchqazw9")
+
+(define %supertest-npm-deps-sha256
+  #f)
+
+(define %supertest-source
+  (origin
+    (method git-fetch)
+    (uri (git-reference
+          (url %supertest-source-url)
+          (commit %supertest-commit)))
+    (file-name (git-file-name "tribes-plugin-supertest" %supertest-version))
+    (sha256
+     (base32 %supertest-source-sha256))))
+
+(define* (supertest-package-from-source source
+                                        #:key
+                                        (host-source tribes-upstream-source)
+                                        (mix-deps-sha256 %supertest-mix-deps-sha256)
+                                        (version %supertest-version))
+  "Build the pinned Supertest source as an external Tribes plugin artifact."
+  (tribes-plugin-package
+   source
+   #:host-source host-source
+   #:mix-deps-sha256 mix-deps-sha256
+   #:build-assets? #f
+   #:digest-assets? #f
+   #:name "tribes-plugin-supertest"
+   #:version version
+   #:home-page %supertest-home-page
+   #:synopsis "Supertest fixture plugin for Tribes"
+   #:description
+   "External Tribes plugin artifact used by live rollout and sync tests."))
+
+(define supertest-package
+  (supertest-package-from-source %supertest-source))
+
+(define* (local-supertest-package directory
+                                  #:key
+                                  host-source
+                                  host-source-directory
+                                  (mix-deps-sha256 %supertest-mix-deps-sha256)
+                                  (version "dev"))
+  "Build a local checkout of tribes-plugin-supertest as an external plugin artifact."
+  (local-tribes-plugin-package
+   directory
+   #:host-source host-source
+   #:host-source-directory host-source-directory
+   #:mix-deps-sha256 mix-deps-sha256
+   #:build-assets? #f
+   #:digest-assets? #f
+   #:name "tribes-plugin-supertest"
+   #:version version
+   #:home-page %supertest-home-page
+   #:synopsis "Supertest fixture plugin for Tribes"
+   #:description
+   "External Tribes plugin artifact used by live rollout and sync tests."))
+
+(define* (supertest-plugin-definition #:key (package supertest-package))
+  "Return the channel-owned plugin definition for Supertest."
+  (tribes-plugin-definition
+   (name "supertest")
+   (package-name "tribes-plugin-supertest")
+   (version "0.1.1")
+   (synopsis "Supertest fixture plugin for Tribes")
+   (home-page %supertest-home-page)
+   (provides '("supertest@1"))
+   (requires '("ecto@1"))
+   (external-plugin (supertest-external-plugin #:package package))))
+
+(define* (supertest-external-plugin #:key package)
+  "Return the channel-owned Guix integration record for the Supertest plugin."
+  (tribes-external-plugin
+   (name "supertest")
+   (package package)
+   (extra-packages '())
+   (extra-services (lambda (_node-config) '()))))

tribes/services/tribes.scm

@@ -423,12 +423,12 @@
           (delete-file human-friendly-config-file))
         (symlink generated-config-file human-friendly-config-file))))
 
-(define (tribes-migrations-shepherd-service config)
+(define (tribes-migration-runner-shepherd-service config provision expression)
   (let* ((launcher (tribes-user-command
                     config
-                    "migrations"
+                    (symbol->string provision)
                     "eval"
-                    '("Tribes.Release.migrate_with_storage_up()")))
+                    (list expression)))
          (capture-launcher
           (program-file
            "tribes-migrations-capture"
@@ -481,8 +481,8 @@
                      (primitive-exit 1))))))))
     (list
      (shepherd-service
-      (documentation "Run Tribes database migrations.")
-      (provision '(tribes-migrations))
+      (documentation (string-append "Run Tribes migration expression: " expression))
+      (provision (list provision))
       (requirement '(postgres user-processes))
       (one-shot? #t)
       (start
@@ -490,6 +490,18 @@
            (zero? (system* #$logged-launcher))))
       (respawn? #f)))))
 
+(define (tribes-migrations-shepherd-service config)
+  (tribes-migration-runner-shepherd-service
+   config
+   'tribes-migrations
+   "Tribes.Release.migrate_with_storage_up()"))
+
+(define (tribes-plugin-rollback-migrations-shepherd-service config)
+  (tribes-migration-runner-shepherd-service
+   config
+   'tribes-plugin-rollback-migrations
+   "Tribes.Release.rollback_plugins(0)"))
+
 (define (tribes-resource-limits config)
   `((nofile
      ,(tribes-configuration-open-files-soft-limit config)
@@ -545,6 +557,7 @@
 
 (define (tribes-root-shepherd-services config)
   (append (tribes-migrations-shepherd-service config)
+          (tribes-plugin-rollback-migrations-shepherd-service config)
           (tribes-shepherd-service config)
           (tribes-local-control-shepherd-service config)))
 

tribes/system/node.scm

@@ -1,5 +1,6 @@
 (define-module (tribes system node)
   #:use-module (gnu packages databases)
+  #:use-module (gnu packages linux)
   #:use-module (gnu services)
   #:use-module (gnu services databases)
   #:use-module (gnu services linux)
@@ -292,7 +293,10 @@
                       postgresql-role-service-type
                       (tribes-node-postgresql-roles config))
       (service tribes-service-type
-               tribes))
+               tribes)
+      (simple-service 'tribes-node-network-tools
+                      profile-service-type
+                      (list iptables)))
      (tribes-node-bbr-services config)
      plugin-services
      (if (tribes-node-configuration-edge config)