feat: build channel plugins in substitute baseline

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.

manifests/substitutes/tribes-node.scm

@@ -4,7 +4,8 @@
   #:use-module (tribes packages otp)
   #:use-module (tribes packages source)
   #:use-module (tribes packages terminals)
-  #:use-module (tribes packages web))
+  #:use-module (tribes packages web)
+  #:use-module (tribes plugins registry))
 
 (define %tribes-node-specifications
   '("nss-certs"
@@ -42,6 +43,7 @@
           hitch
           vinyl
           lego
-          (tribes-node-package)))))
+          (tribes-node-package))
+    (guix-tribes-plugin-substitute-packages))))
 
 (make-tribes-node-manifest)

pins/base-channels.sexp

@@ -2,9 +2,9 @@
         (name 'guix)
         (url "https://git.teralink.net/tribes/guix-fork.git")
         (branch "master")
-        ;; Guix v1.5.0
+        ;; guix-fork master
         (commit
-          "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90")
+          "906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
         (introduction
           (make-channel-introduction
             "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90"

pins/legion-channels.sexp

@@ -3,9 +3,9 @@
     (name 'guix)
     (url "https://git.teralink.net/tribes/guix-fork.git")
     (branch "master")
-    ;; Guix v1.5.0
+    ;; guix-fork master
     (commit
-      "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90")
+      "906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
     (introduction
       (make-channel-introduction
         "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90"

tests/support.scm

@@ -0,0 +1,16 @@
+(define-module (tests support)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-13)
+  #:export (run-tests-when-script))
+
+(define (script-invocation? argv file-name)
+  (match argv
+    ((program . _)
+     (and (string? program)
+          (or (string=? program file-name)
+              (string-suffix? (string-append "/" file-name) program))))
+    (_ #f)))
+
+(define (run-tests-when-script file-name thunk)
+  (when (script-invocation? (command-line) file-name)
+    (thunk)))

tests/tribes-deploy-current-guix.scm

@@ -2,6 +2,7 @@
   #:use-module (ice-9 textual-ports)
   #:use-module (guix build utils)
   #:use-module (srfi srfi-64)
+  #:use-module (tests support)
   #:use-module (tribes deploy current-guix)
   #:export (run-tests))
 
@@ -102,4 +103,4 @@
 
   (test-end "tribes-deploy-current-guix"))
 
-(run-tests)
+(run-tests-when-script "tests/tribes-deploy-current-guix.scm" run-tests)

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))

tests/tribes-deploy-operations.scm

@@ -5,11 +5,13 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-64)
+  #:use-module (tests support)
   #:use-module (tribes deploy config)
   #:use-module (tribes deploy executor)
   #: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,11 @@
   '(("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 (delete-if-present path)
   (when (false-if-exception (lstat path))
     (delete-file path)))
@@ -158,6 +165,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 +245,48 @@
          (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))))
+    (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 +301,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)))
@@ -361,4 +420,4 @@
 
   (test-end "tribes-deploy-operations"))
 
-(run-tests)
+(run-tests-when-script "tests/tribes-deploy-operations.scm" run-tests)

tests/tribes-deploy-worker.scm

@@ -0,0 +1,145 @@
+(define-module (tests tribes-deploy-worker)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 atomic)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-64)
+  #:use-module (tests support)
+  #:use-module (tribes deploy config)
+  #:use-module (tribes deploy json)
+  #:use-module (tribes deploy state)
+  #:use-module (tribes deploy worker)
+  #:export (run-tests))
+
+(define *fixture-counter* 0)
+
+(define (delete-directory-if-present path)
+  (when (false-if-exception (lstat path))
+    (delete-file-recursively path)))
+
+(define (fresh-root)
+  (set! *fixture-counter* (+ *fixture-counter* 1))
+  (let ((root (string-append "/tmp/tribes-worker-test-"
+                             (number->string *fixture-counter*))))
+    (delete-directory-if-present root)
+    (mkdir-p root)
+    root))
+
+(define (fixture-config root)
+  (deploy-config
+   (deploy-directory (string-append root "/deploy"))
+   (host-config-file (string-append root "/host-config.json"))
+   (channels-file (string-append root "/channels.scm"))
+   (current-config-file (string-append root "/configuration.scm"))
+   (current-system-link (string-append root "/run/current-system"))
+   (system-profile-link (string-append root "/profiles/system"))
+   (system-profile-directory (string-append root "/profiles"))
+   (helper-binary "fake-helper-not-used")))
+
+(define (eventually? predicate)
+  (let loop ((attempts 200))
+    (cond
+     ((predicate) #t)
+     ((zero? attempts) #f)
+     (else
+      (usleep 10000)
+      (loop (- attempts 1))))))
+
+(define (snapshot-field worker key)
+  (json-ref (worker-status worker) key))
+
+(define (run-tests)
+  (test-begin "tribes-deploy-worker")
+
+  (let* ((root (fresh-root))
+         (config (fixture-config root))
+         (state (make-state-store config))
+         (worker (make-worker config state))
+         (release? (make-atomic-box #f)))
+    (call-with-values
+        (lambda ()
+          (worker-submit!
+           worker 'prepare "plan-a"
+           (lambda (update!)
+             (update! "pulling")
+             (let loop ()
+               (unless (atomic-box-ref release?)
+                 (usleep 10000)
+                 (loop)))
+             (update! "building")
+             (make-job-result
+              #t
+              '(("schemaVersion" . "2")
+                ("ok" . #t)
+                ("status" . "completed")
+                ("phase" . "ready")
+                ("plan_hash" . "plan-a"))))))
+      (lambda (status snapshot)
+        (test-equal "worker accepts first long-running job"
+          'accepted status)
+        (test-equal "accepted job starts queued"
+          "queued" (json-ref snapshot "phase"))))
+    (test-assert "worker status reaches helper phase while job runs"
+      (eventually? (lambda ()
+                     (string=? (or (snapshot-field worker "phase") "")
+                               "pulling"))))
+    (call-with-values
+        (lambda ()
+          (worker-submit! worker 'prepare "plan-a"
+                          (lambda (_update!)
+                            (make-job-result #t '()))))
+      (lambda (status _snapshot)
+        (test-equal "same plan is idempotent while running"
+          'idempotent status)))
+    (call-with-values
+        (lambda ()
+          (worker-submit! worker 'prepare "plan-b"
+                          (lambda (_update!)
+                            (make-job-result #t '()))))
+      (lambda (status snapshot)
+        (test-equal "different plan is busy while running"
+          'busy status)
+        (test-equal "busy response exposes running phase"
+          "pulling" (json-ref snapshot "phase"))))
+    (let ((aborted (worker-abort! worker)))
+      (test-equal "abort marks snapshot aborted"
+        "aborted" (json-ref aborted "phase")))
+    (call-with-values
+        (lambda ()
+          (worker-submit! worker 'prepare "plan-c"
+                          (lambda (_update!)
+                            (make-job-result #t '()))))
+      (lambda (status snapshot)
+        (test-equal "aborted running job still blocks new work"
+          'busy status)
+        (test-equal "busy response preserves aborted phase"
+          "aborted" (json-ref snapshot "phase"))))
+    (atomic-box-set! release? #t)
+    (test-assert "worker records final result after long job exits"
+      (eventually? (lambda ()
+                     (string=? (or (snapshot-field worker "status") "")
+                               "completed"))))
+    (worker-shutdown! worker))
+
+  (let* ((root (fresh-root))
+         (config (fixture-config root))
+         (state (make-state-store config))
+         (worker (make-worker config state)))
+    (call-with-values
+        (lambda ()
+          (worker-submit! worker 'prepare "plan-error"
+                          (lambda (_update!)
+                            (error "synthetic worker failure"))))
+      (lambda (status _snapshot)
+        (test-equal "worker accepts failing job"
+          'accepted status)))
+    (test-assert "worker converts job exceptions into failed snapshots"
+      (eventually? (lambda ()
+                     (string=? (or (snapshot-field worker "status") "")
+                               "failed"))))
+    (test-equal "worker failure snapshot is machine readable"
+      "broker_internal" (snapshot-field worker "code"))
+    (worker-shutdown! worker))
+
+  (test-end "tribes-deploy-worker"))
+
+(run-tests-when-script "tests/tribes-deploy-worker.scm" run-tests)

tests/tribes-diagnostics-system-generations.scm

@@ -1,11 +1,19 @@
 (define-module (tests tribes-diagnostics-system-generations)
+  #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-64)
+  #:use-module (tests support)
   #: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 +58,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)
+(run-tests-when-script "tests/tribes-diagnostics-system-generations.scm" run-tests)

tests/tribes-system-node.scm

@@ -4,6 +4,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-64)
+  #:use-module (tests support)
   #:use-module (tribes services tribes)
   #:use-module (tribes services vinyl)
   #:use-module (tribes system node)
@@ -66,4 +67,4 @@
 
   (test-end "tribes-system-node"))
 
-(run-tests)
+(run-tests-when-script "tests/tribes-system-node.scm" 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/handlers.scm

@@ -115,7 +115,9 @@
      (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
+                         #:pull-required?
+                         (plan-requires-pull? payload)))))))
 
 (define (handle-commit state worker helper payload)
   (let ((err (validate-commit-input payload)))

tribes/deploy/operations.scm

@@ -140,7 +140,8 @@
 (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 (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"
@@ -169,10 +170,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 +226,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 +282,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 +307,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 +350,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 +410,9 @@
 (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
+                                     #: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 +438,8 @@
                 (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 (pull-required? #t))
   (call-with-values
       (lambda ()
         (worker-submit!
@@ -416,7 +451,8 @@
                       (update! phase)))))
              (%make-job-result-from-payload
               (prepare-plugins! state helper plugins
-                                plan-hash-value on-frame))))))
+                                plan-hash-value on-frame
+                                #: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/deploy/worker.scm

@@ -197,7 +197,8 @@
            (plan-hash (assoc "plan_hash" status)))
       (and phase
            (member (cdr phase)
-                   '("queued" "running" "pulling" "building" "switching"))
+                   '("queued" "running" "pulling" "building" "switching"
+                     "aborted"))
            job-id
            `((id . ,(cdr job-id))
              (plan-hash . ,(and plan-hash (cdr plan-hash))))))))

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")
@@ -200,8 +200,7 @@ package-lock.json."
 
          (mkdir-p out)
          (copy-recursively (string-append plugin-assets-dir "/node_modules")
-                           out
-                           #:follow-symlinks? #t)))
+                           out)))
    #:options
    `(#:hash ,(base32 sha256)
      #:hash-algo sha256
@@ -264,17 +263,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 +314,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 +370,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
@@ -239,9 +251,20 @@ lib/*/ebin."
                     (when (file-exists? node-modules-dir)
                       (delete-file-recursively node-modules-dir))
                     (copy-recursively #+asset-deps-source
-                                      node-modules-dir
-                                      #:follow-symlinks? #t)
-                    (invoke "chmod" "-R" "u+w" node-modules-dir)))
+                                      node-modules-dir)
+                    (invoke "chmod" "-R" "u+w" node-modules-dir)
+                    (invoke "find"
+                            node-modules-dir
+                            "-type" "f"
+                            "-path" "*/.bin/*"
+                            "-exec" "chmod" "+x" "{}" "+")
+                    (let ((bin-dir (string-append node-modules-dir "/.bin")))
+                      (when (file-exists? bin-dir)
+                        (for-each
+                         (lambda (script)
+                           (patch-shebang (canonicalize-path script)
+                                          (list #$(file-append node "/bin"))))
+                         (find-files bin-dir))))))
               plugin-api-setup-gexp))
          (resolved-asset-build-gexp
           (cond
@@ -268,35 +291,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 +346,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

@@ -53,7 +53,7 @@
   "https://git.teralink.net/tribes/tribes.git")
 
 (define %tribes-commit
-  "96da023db957784d711cbd791ae38dd376351857")
+  "2c4deb96d1b640442e04c6c650b5b9380a2381e2")
 
 (define %tribes-revision "1")
 
@@ -61,7 +61,7 @@
   (git-version "0.2.0" %tribes-revision %tribes-commit))
 
 (define %tribes-source-sha256
-  "063vy13mhil3cnj1nb0ra2r8b5cq286z1ix7didkiifqyb3zdzyi")
+  "1i38ci4fh25lzcwwxycq6ppzymvkkgncsva9mqxxv6ghcw31xpsz")
 
 (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,15 +1,20 @@
 (define-module (tribes plugins registry)
   #:use-module (tribes packages plugins)
   #:use-module (tribes plugins aether)
+  #:use-module (tribes plugins sender)
+  #:use-module (tribes plugins supertest)
   #:use-module (srfi srfi-1)
   #:export (guix-tribes-plugin-catalog
             guix-tribes-plugin-definition-by-name
             guix-tribes-plugin-definitions
-            guix-tribes-external-plugins))
+            guix-tribes-external-plugins
+            guix-tribes-plugin-substitute-packages))
 
 (define guix-tribes-plugin-definitions
   (list
-   (aether-plugin-definition)))
+   (aether-plugin-definition)
+   (sender-plugin-definition)
+   (supertest-plugin-definition)))
 
 (define guix-tribes-plugin-catalog
   (tribes-plugin-catalog-file guix-tribes-plugin-definitions))
@@ -18,6 +23,18 @@
   (map tribes-plugin-definition-external-plugin
        guix-tribes-plugin-definitions))
 
+(define (guix-tribes-plugin-substitute-packages)
+  "Return packages needed to prebuild channel-owned plugin closures."
+  (delete-duplicates
+   (append-map
+    (lambda (plugin)
+      (let ((external-plugin
+             (tribes-plugin-definition-external-plugin plugin)))
+        (cons (tribes-external-plugin-package external-plugin)
+              (tribes-external-plugin-extra-packages external-plugin))))
+    guix-tribes-plugin-definitions)
+   eq?))
+
 (define (guix-tribes-plugin-definition-by-name name)
   (find (lambda (plugin-definition)
           (string=? (tribes-plugin-definition-name plugin-definition) name))

tribes/plugins/sender.scm

@@ -0,0 +1,116 @@
+(define-module (tribes plugins sender)
+  #:use-module (guix git-download)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (gnu packages video)
+  #:use-module (tribes packages plugins)
+  #:use-module (tribes packages source)
+  #:export (sender-package
+            sender-plugin-definition
+            sender-external-plugin
+            local-sender-package))
+
+(define %sender-home-page
+  "https://git.teralink.net/tribes/tribes-plugin-sender")
+
+(define %sender-source-url
+  %sender-home-page)
+
+(define %sender-commit
+  "1f3df4c8ed13ec3d2abdc542d34246b50c397da1")
+
+(define %sender-revision "1")
+
+(define %sender-version
+  (git-version "0.1.0" %sender-revision %sender-commit))
+
+(define %sender-source-sha256
+  "1gq4kag3q9iz17j8a4hqg07v9pw2b6lgrbssb0bxkfqk3zl07ckj")
+
+(define %sender-mix-deps-sha256
+  "0dacj6c9mhxw37ykksjbhmnsqdhrwpkfsbswm68d2wvcwchqazw9")
+
+(define %sender-npm-deps-sha256
+  "1inziz2028pidg5xag40qqrlpigbvs23jirm41in7d58avlmxmh7")
+
+(define %sender-source
+  (origin
+    (method git-fetch)
+    (uri (git-reference
+          (url %sender-source-url)
+          (commit %sender-commit)))
+    (file-name (git-file-name "tribes-plugin-sender" %sender-version))
+    (sha256
+     (base32 %sender-source-sha256))))
+
+(define* (sender-package-from-source source
+                                     #:key
+                                     (host-source tribes-upstream-source)
+                                     (mix-deps-sha256 %sender-mix-deps-sha256)
+                                     (asset-deps-sha256 %sender-npm-deps-sha256)
+                                     (version %sender-version))
+  "Build the pinned Sender source as an external Tribes plugin artifact."
+  (tribes-plugin-package
+   source
+   #:host-source host-source
+   #:mix-deps-sha256 mix-deps-sha256
+   #:build-assets? #t
+   #:digest-assets? #t
+   #:asset-deps-sha256 asset-deps-sha256
+   #:name "tribes-plugin-sender"
+   #:version version
+   #:home-page %sender-home-page
+   #:synopsis "RTMP ingest and HLS streaming plugin for Tribes"
+   #:description
+   "External Tribes plugin artifact for RTMP ingest and HLS streaming,
+packaged as a Guix-managed plugin directory."))
+
+(define sender-package
+  (sender-package-from-source %sender-source))
+
+(define* (local-sender-package directory
+                               #:key
+                               host-source
+                               host-source-directory
+                               (build-assets? #t)
+                               (digest-assets? #t)
+                               (mix-deps-sha256 %sender-mix-deps-sha256)
+                               (asset-deps-sha256 %sender-npm-deps-sha256)
+                               (version "dev"))
+  "Build a local checkout of tribes-plugin-sender 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? build-assets?
+   #:digest-assets? digest-assets?
+   #:asset-deps-sha256 asset-deps-sha256
+   #:name "tribes-plugin-sender"
+   #:version version
+   #:home-page %sender-home-page
+   #:synopsis "RTMP ingest and HLS streaming plugin for Tribes"
+   #:description
+   "External Tribes plugin artifact for RTMP ingest and HLS streaming,
+packaged as a Guix-managed plugin directory."))
+
+(define* (sender-plugin-definition #:key (package sender-package))
+  "Return the channel-owned plugin definition for Sender."
+  (tribes-plugin-definition
+   (name "sender")
+   (package-name "tribes-plugin-sender")
+   (version "0.1.0")
+   (synopsis "RTMP ingest and HLS streaming plugin for Tribes")
+   (home-page %sender-home-page)
+   (provides '("streaming@1"))
+   (requires '("ecto@1" "ui@1"))
+   (external-plugin (sender-external-plugin #:package package))))
+
+(define* (sender-external-plugin #:key package)
+  "Return the channel-owned Guix integration record for the Sender plugin."
+  (tribes-external-plugin
+   (name "sender")
+   (package package)
+   (extra-packages (list ffmpeg))
+   (extra-services (lambda (_node-config) '()))))

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
+  "e042f3265db7a40d4d558132800238c6d466e8dd")
+
+(define %supertest-revision "1")
+
+(define %supertest-version
+  (git-version "0.1.0" %supertest-revision %supertest-commit))
+
+(define %supertest-source-sha256
+  "1rv844pnvqpc6yzcyg6qb013vbyfg8kipr6mdxkb17434djsmn1c")
+
+(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.0")
+   (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)))