about summary refs log tree commit diff
path: root/guix/forge/laminar.scm
diff options
context:
space:
mode:
authorArun Isaac2022-03-02 17:55:27 +0530
committerArun Isaac2022-03-02 21:04:17 +0530
commitcb7cecae3f6152052bdaf601eb1f6fcb2727b6b9 (patch)
treee369c485363fb08ed2b294e1602d4a209754d506 /guix/forge/laminar.scm
parent419d982bb29dd8a3904e6591796cc7ebc9190fd8 (diff)
downloadguix-forge-cb7cecae3f6152052bdaf601eb1f6fcb2727b6b9.tar.gz
guix-forge-cb7cecae3f6152052bdaf601eb1f6fcb2727b6b9.tar.lz
guix-forge-cb7cecae3f6152052bdaf601eb1f6fcb2727b6b9.zip
Move channel modules into subdirectory.
We don't want the scm files in doc to be picked up on `guix pull'.

* .guix-channel: New file.
* forge: Move to guix/forge.
Diffstat (limited to 'guix/forge/laminar.scm')
-rw-r--r--guix/forge/laminar.scm135
1 files changed, 135 insertions, 0 deletions
diff --git a/guix/forge/laminar.scm b/guix/forge/laminar.scm
new file mode 100644
index 0000000..5d95372
--- /dev/null
+++ b/guix/forge/laminar.scm
@@ -0,0 +1,135 @@
+;;; guix-forge --- Guix software forge meta-service
+;;; Copyright © 2021, 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of guix-forge.
+;;;
+;;; guix-forge is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; guix-forge is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with guix-forge.  If not, see
+;;; <https://www.gnu.org/licenses/>.
+
+(define-module (forge laminar)
+  #:use-module (gnu)
+  #:use-module (srfi srfi-1)
+  #:use-module (gnu packages ci)
+  #:use-module (gnu services ci)
+  #:use-module (guix records)
+  #:export (forge-laminar-service-type
+            forge-laminar-configuration
+            forge-laminar-configuration?
+            forge-laminar-configuration-state-directory
+            forge-laminar-configuration-jobs
+            forge-laminar-job
+            forge-laminar-job?
+            this-forge-laminar-job
+            forge-laminar-job-name
+            forge-laminar-job-run
+            forge-laminar-job-after
+            forge-laminar-group
+            forge-laminar-group?
+            forge-laminar-group-name
+            forge-laminar-group-regex))
+
+(define-record-type* <forge-laminar-configuration>
+  forge-laminar-configuration make-forge-laminar-configuration
+  forge-laminar-configuration?
+  (state-directory forge-laminar-configuration-state-directory
+                   (default "/var/lib/laminar"))
+  (jobs forge-laminar-configuration-jobs
+        (default '()))
+  (groups forge-laminar-configuration-groups
+          (default '())))
+
+(define-record-type* <forge-laminar-job>
+  forge-laminar-job make-forge-laminar-job
+  forge-laminar-job?
+  this-forge-laminar-job
+  (name forge-laminar-job-name)
+  (run forge-laminar-job-run (thunked))
+  (after forge-laminar-job-after
+         (default #f)))
+
+(define-record-type* <forge-laminar-group>
+  forge-laminar-group make-forge-laminar-group
+  forge-laminar-group?
+  (name forge-laminar-group-name)
+  (regex forge-laminar-group-regex))
+
+(define (forge-laminar-activation config)
+  (let* ((state-directory (forge-laminar-configuration-state-directory config))
+         (configuration-directory (string-append state-directory "/cfg"))
+         (groups-configuration (string-append configuration-directory "/groups.conf"))
+         (jobs-directory (string-append configuration-directory "/jobs")))
+    #~(begin
+        (use-modules (srfi srfi-26))
+
+        ;; Ensure configuration directory exists.
+        (mkdir-p #$configuration-directory)
+        ;; Configure groups.
+        (when (file-exists? #$groups-configuration)
+          (delete-file #$groups-configuration))
+        (symlink
+         #$(plain-file "laminar-groups"
+                       (string-join (map (lambda (group)
+                                           (string-append (forge-laminar-group-name group)
+                                                          "="
+                                                          (forge-laminar-group-regex group)))
+                                         (forge-laminar-configuration-groups config))
+                                    "\n"))
+         #$groups-configuration)
+        ;; Create jobs directory and populate with job scripts.
+        (mkdir-p #$(dirname jobs-directory))
+        (when (file-exists? #$jobs-directory)
+          (delete-file #$jobs-directory))
+        (symlink
+         #$(file-union "laminar-jobs"
+                       (append-map (lambda (job)
+                                     (let ((name (forge-laminar-job-name job))
+                                           (run (forge-laminar-job-run job))
+                                           (after (forge-laminar-job-after job)))
+                                       (cons (list (string-append name ".run")
+                                                   (program-file name run))
+                                             (if after
+                                                 (list (list (string-append name ".after")
+                                                             (program-file name after)))
+                                                 (list)))))
+                                   (forge-laminar-configuration-jobs config)))
+         #$jobs-directory)
+        ;; Set permissions for laminar directory.
+        (for-each (lambda (file)
+                    (let ((user (getpw "laminar")))
+                      (chown file (passwd:uid user) (passwd:gid user))))
+                  (find-files #$state-directory
+                              (lambda (file stat)
+                                (memq (stat:type stat)
+                                      '(regular directory)))
+                              #:directories? #t)))))
+
+(define forge-laminar-service-type
+  (service-type
+   (name 'forge-laminar)
+   (description "Run forge-laminar.")
+   (extensions (list (service-extension activation-service-type
+                                        forge-laminar-activation)
+                     ;; Extend the laminar service with a dummy value,
+                     ;; thus requiring it.
+                     (service-extension laminar-service-type
+                                        (const #t))))
+   (compose concatenate)
+   (extend (lambda (config extended-values)
+             (forge-laminar-configuration
+              (inherit config)
+              (jobs (append (forge-laminar-configuration-jobs config)
+                            (filter forge-laminar-job? extended-values)))
+              (groups (append (forge-laminar-configuration-groups config)
+                              (filter forge-laminar-group? extended-values))))))
+   (default-value (forge-laminar-configuration))))