tissue: Update to 0.1.0-2.a918759.

* guix/forge/tissue.scm (tissue): Update to 0.1.0-2.a918759.
(<tissue-host>)[user, upstream-repository]: Delete fields.
[projects]: New field.
(<tissue-project>): New record type.
(tissue-conf-gexp): Serialize tissue.conf in accordance with update.
(tissue-activation): Find project directories to chown from new
configuration record structure.

1 files changed, 53 insertions, 25 deletions

diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm
index 4ece204..0e7791e 100644
--- a/guix/forge/tissue.scm
+++ b/guix/forge/tissue.scm
@@ -1,5 +1,5 @@
 ;;; guix-forge --- Guix software forge meta-service
-;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2022, 2023, 2025 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of guix-forge.
 ;;;
@@ -46,14 +46,19 @@
             tissue-host
             tissue-host?
             tissue-host-name
-            tissue-host-user
-            tissue-host-upstream-repository))
+            tissue-host-projects
+            <tissue-project>
+            tissue-project
+            tissue-project-name
+            tissue-project-user
+            tissue-project-base-path
+            tissue-project-upstream-repository))
 
 ;; Run an updated version of tissue until the the 0.1.1 release is
 ;; out.
 (define-public tissue
-  (let ((commit "0c3d6cb7d781fbc0c12eba1563cc7b7ebb370ba9")
-        (revision "1"))
+  (let ((commit "a9187595cccca4954c7d4920b93b922ea190e179")
+        (revision "2"))
     (package
       (inherit guix:tissue)
       (name "tissue")
@@ -66,7 +71,7 @@
                 (file-name (git-file-name name version))
                 (sha256
                  (base32
-                  "0hdqa5n8dm2nc4ccx39xclgajv3ivwpb1hbz9kpbbv25iizqhnv2"))))
+                  "0pgdznck8vwmbccmpcqd3xnikbgzb2phxik7bcm80dls6g4n3py2"))))
       (inputs
        (modify-inputs (package-inputs guix:tissue)
          (replace "guile-git" guile-git))))))
@@ -88,9 +93,22 @@
   tissue-host make-tissue-host
   tissue-host?
   (name tissue-host-name)
-  (user tissue-host-user
+  (projects tissue-host-projects
+            (default '())))
+
+(define-record-type* <tissue-project>
+  tissue-project make-tissue-project
+  tissue-project?
+  this-tissue-project
+  (name tissue-project-name)
+  (user tissue-project-user
         (default "tissue"))
-  (upstream-repository tissue-host-upstream-repository))
+  (base-path tissue-project-base-path
+             (default (string-append "/"
+                                     (tissue-project-name this-tissue-project)
+                                     "/"))
+             (thunked))
+  (upstream-repository tissue-project-upstream-repository))
 
 (define %tissue-accounts
   (list (user-account
@@ -105,6 +123,19 @@
          (system? #t))))
 
 (define (tissue-conf-gexp config)
+  (define project->alist
+    (match-record-lambda <tissue-project>
+        (name base-path upstream-repository)
+      `(,name
+        (base-path . ,base-path)
+        (upstream-repository . ,upstream-repository))))
+
+  (define host->alist
+    (match-record-lambda <tissue-host>
+        (name projects)
+      `(,name
+        (projects . ,(map project->alist projects)))))
+
   (match-record config <tissue-configuration>
     (socket state-directory hosts)
     #~(begin
@@ -129,11 +160,7 @@
                                            "Socket must be a <forge-ip-socket> or <forge-unix-socket> record")
                                           (make-irritants-condition socket))))))
                (state-directory . #$state-directory)
-               (hosts . #$(map (lambda (host)
-                                 (match-record host <tissue-host>
-                                   (name upstream-repository)
-                                   `(,name (upstream-repository . ,upstream-repository))))
-                               hosts)))
+               (hosts . #$(map host->alist hosts)))
              port))))))
 
 ;; We cannot just pass the configuration file on the command-line
@@ -162,22 +189,23 @@
             ;; the tissue user.
             (mkdir-p #$state-directory)
             (chown #$state-directory (passwd:uid user) (passwd:gid user)))
-          ;; Create host directories if they don't exist, and set
-          ;; permissions. Each host directory may be owned by its own
-          ;; user.
+          ;; Create project directories if they don't exist, and set
+          ;; permissions. Each project directory may be owned by its
+          ;; own user.
           (for-each (match-lambda
-                      ((hostname username)
-                       (let ((host-directory (string-append #$state-directory "/" hostname))
+                      ((project-name username)
+                       (let ((project-directory (string-append #$state-directory "/" project-name))
                              (user (getpw username)))
-                         (mkdir-p host-directory)
+                         (mkdir-p project-directory)
                          (for-each (lambda (file)
                                      (chown file (passwd:uid user) (passwd:gid user)))
-                                   (find-files host-directory #:directories? #t)))))
-                    '#$(map (lambda (host)
-                              (match-record host <tissue-host>
-                                (name user)
-                                (list name user)))
-                            hosts))))))
+                                   (find-files project-directory #:directories? #t)))))
+                    '#$(append-map (lambda (host)
+                                     (map (match-record-lambda <tissue-project>
+                                              (name user)
+                                            (list name user))
+                                          (tissue-host-projects host)))
+                                   hosts))))))
 
 (define (tissue-shepherd-service config)
   (match-record config <tissue-configuration>