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

manifests/substitutes/tribes-node.scm

@@ -4,8 +4,7 @@
   #:use-module (tribes packages otp)
   #:use-module (tribes packages source)
   #:use-module (tribes packages terminals)
-  #:use-module (tribes packages web)
-  #:use-module (tribes plugins registry))
+  #:use-module (tribes packages web))
 
 (define %tribes-node-specifications
   '("nss-certs"
@@ -43,7 +42,6 @@
           hitch
           vinyl
           lego
-          (tribes-node-package))
-    (guix-tribes-plugin-substitute-packages))))
+          (tribes-node-package)))))
 
 (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-fork master
+        ;; Guix v1.5.0
         (commit
-          "906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
+          "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90")
         (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-fork master
+    ;; Guix v1.5.0
     (commit
-      "906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
+      "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90")
     (introduction
       (make-channel-introduction
         "6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90"

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/support.scm

@@ -1,16 +0,0 @@
-(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,7 +2,6 @@
   #: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))
 
@@ -60,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")
@@ -87,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")))
@@ -95,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
@@ -103,4 +105,4 @@
 
   (test-end "tribes-deploy-current-guix"))
 
-(run-tests-when-script "tests/tribes-deploy-current-guix.scm" run-tests)
+(run-tests)

tests/tribes-deploy-executor.scm

@@ -93,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,11 +1,11 @@
 (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)
   #: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)
@@ -30,6 +30,17 @@
     ("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)))
@@ -115,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"))
@@ -262,6 +276,34 @@
           (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
@@ -420,4 +462,4 @@
 
   (test-end "tribes-deploy-operations"))
 
-(run-tests-when-script "tests/tribes-deploy-operations.scm" run-tests)
+(run-tests)

tests/tribes-deploy-worker.scm

@@ -1,145 +0,0 @@
-(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,7 +1,6 @@
 (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))
 
@@ -73,4 +72,4 @@
 
   (test-end "tribes-diagnostics-system-generations"))
 
-(run-tests-when-script "tests/tribes-diagnostics-system-generations.scm" run-tests)
+(run-tests)

tests/tribes-system-node.scm

@@ -4,7 +4,6 @@
   #: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)
@@ -67,4 +66,4 @@
 
   (test-end "tribes-system-node"))
 
-(run-tests-when-script "tests/tribes-system-node.scm" run-tests)
+(run-tests)

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

@@ -116,6 +116,7 @@
       (let ((plugins (plan-plugins payload))
             (plan-hash-value (plan-hash payload)))
         (submit-prepare! state worker helper plugins plan-hash-value
+                         #:plan payload
                          #:pull-required?
                          (plan-requires-pull? payload)))))))
 

tribes/deploy/operations.scm

@@ -134,6 +134,92 @@
          (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))
 
@@ -141,7 +227,8 @@
   (state-store-running-system-path state))
 
 (define* (prepare-plugins! state helper plugins plan-hash-value on-frame
-                           #:key (pull-required? #t))
+                           #: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"
@@ -149,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.
@@ -411,6 +500,7 @@
   (let* ((plan-hash-value (plan-hash plan))
          (prepared (prepare-plugins! state helper (plan-plugins plan)
                                      plan-hash-value on-frame
+                                     #:plan plan
                                      #:pull-required?
                                      (plan-requires-pull? plan))))
     (if (equal? (json-ref prepared "ok") #t)
@@ -439,7 +529,8 @@
               snapshot)))
 
 (define* (submit-prepare! state worker helper plugins plan-hash-value
-                          #:key (pull-required? #t))
+                          #:key plan
+                          (pull-required? #t))
   (call-with-values
       (lambda ()
         (worker-submit!
@@ -452,6 +543,7 @@
              (%make-job-result-from-payload
               (prepare-plugins! state helper plugins
                                 plan-hash-value on-frame
+                                #:plan plan
                                 #:pull-required? pull-required?))))))
     (lambda (status snapshot)
       (case status

tribes/deploy/worker.scm

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

tribes/packages/mix.scm

@@ -200,7 +200,8 @@ package-lock.json."
 
          (mkdir-p out)
          (copy-recursively (string-append plugin-assets-dir "/node_modules")
-                           out)))
+                           out
+                           #:follow-symlinks? #t)))
    #:options
    `(#:hash ,(base32 sha256)
      #:hash-algo sha256

tribes/packages/plugins.scm

@@ -251,20 +251,9 @@ lib/*/ebin."
                     (when (file-exists? node-modules-dir)
                       (delete-file-recursively node-modules-dir))
                     (copy-recursively #+asset-deps-source
-                                      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))))))
+                                      node-modules-dir
+                                      #:follow-symlinks? #t)
+                    (invoke "chmod" "-R" "u+w" node-modules-dir)))
               plugin-api-setup-gexp))
          (resolved-asset-build-gexp
           (cond

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
-  "2c4deb96d1b640442e04c6c650b5b9380a2381e2")
+  "d5d4d62b0f941b74749702c393743d2db009aba2")
 
 (define %tribes-revision "1")
 
@@ -61,7 +61,7 @@
   (git-version "0.2.0" %tribes-revision %tribes-commit))
 
 (define %tribes-source-sha256
-  "1i38ci4fh25lzcwwxycq6ppzymvkkgncsva9mqxxv6ghcw31xpsz")
+  "1pkl0xpf95n5ravqs1m79084l3nklfwjhsrzihyj1cpm01dfc5np")
 
 (define %tribes-upstream-source
   (origin

tribes/plugins/registry.scm

@@ -1,19 +1,16 @@
 (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-plugin-substitute-packages))
+            guix-tribes-external-plugins))
 
 (define guix-tribes-plugin-definitions
   (list
    (aether-plugin-definition)
-   (sender-plugin-definition)
    (supertest-plugin-definition)))
 
 (define guix-tribes-plugin-catalog
@@ -23,18 +20,6 @@
   (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

@@ -1,116 +0,0 @@
-(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

@@ -16,15 +16,15 @@
   %supertest-home-page)
 
 (define %supertest-commit
-  "e042f3265db7a40d4d558132800238c6d466e8dd")
+  "c5b2a3b2e70082877d64697a991526f25d8a6671")
 
 (define %supertest-revision "1")
 
 (define %supertest-version
-  (git-version "0.1.0" %supertest-revision %supertest-commit))
+  (git-version "0.1.1" %supertest-revision %supertest-commit))
 
 (define %supertest-source-sha256
-  "1rv844pnvqpc6yzcyg6qb013vbyfg8kipr6mdxkb17434djsmn1c")
+  "097z65nhvci2r5qk7pb7w75ig9hsw8rplwbv89hi5n6kmqafdhq3")
 
 (define %supertest-mix-deps-sha256
   "0dacj6c9mhxw37ykksjbhmnsqdhrwpkfsbswm68d2wvcwchqazw9")
@@ -90,7 +90,7 @@
   (tribes-plugin-definition
    (name "supertest")
    (package-name "tribes-plugin-supertest")
-   (version "0.1.0")
+   (version "0.1.1")
    (synopsis "Supertest fixture plugin for Tribes")
    (home-page %supertest-home-page)
    (provides '("supertest@1"))

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)