;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2021–2022, 2024–2025 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)
#:use-module (ice-9 match)
#:export (forge-laminar-service-type
forge-laminar-configuration
forge-laminar-configuration?
forge-laminar-configuration-state-directory
forge-laminar-configuration-jobs
forge-laminar-configuration-contexts
forge-laminar-configuration-groups
forge-laminar-job
forge-laminar-job?
this-forge-laminar-job
forge-laminar-job-name
forge-laminar-job-run
forge-laminar-job-after
forge-laminar-job-trigger?
forge-laminar-job-contexts
forge-laminar-context
forge-laminar-context?
forge-laminar-context-name
forge-laminar-context-executors
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 '()))
(contexts forge-laminar-configuration-contexts
(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))
(trigger? forge-laminar-job-trigger?
(default #t))
(contexts forge-laminar-job-contexts
(default '())))
(define-record-type* <forge-laminar-context>
forge-laminar-context make-forge-laminar-context
forge-laminar-context?
(name forge-laminar-context-name)
(executors forge-laminar-context-executors))
(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 (laminar-contexts contexts)
"Return a file-like object describing a directory of @var{contexts}, a
list of @var{<forge-laminar-context>} objects."
(file-union "laminar-contexts"
(map (lambda (context)
(let ((configuration-file
(string-append (forge-laminar-context-name context)
".conf")))
(list configuration-file
(mixed-text-file configuration-file
"EXECUTORS="
(number->string (forge-laminar-context-executors context))
"\n"))))
contexts)))
(define (laminar-groups groups)
"Return a file-like object describing @var{groups}, a list of
@code{<forge-laminar-groups>} objects."
(plain-file "laminar-groups"
(string-join (map (lambda (group)
(string-append (forge-laminar-group-name group)
"="
(forge-laminar-group-regex group)))
groups)
"\n")))
(define (laminar-jobs jobs)
"Return a file-like object describing a directory of @var{jobs}, a list
of @var{<forge-laminar-job>} objects."
(file-union "laminar-jobs"
(append-map (lambda (job)
(let ((name (forge-laminar-job-name job)))
`(,(let ((run-name (string-append name ".run")))
`(,run-name ,(program-file run-name
(forge-laminar-job-run job))))
,@(let ((after (forge-laminar-job-after job))
(after-name (string-append name ".after")))
(if after
`((,after-name ,(program-file after-name after)))
'()))
,@(match (forge-laminar-job-contexts job)
(() '())
(contexts
(let ((conf-name (string-append name ".conf")))
`((,conf-name ,(mixed-text-file conf-name
"CONTEXTS="
(string-join contexts ",")
"\n")))))))))
jobs)))
(define (forge-laminar-activation config)
(let* ((state-directory (forge-laminar-configuration-state-directory config))
(configuration-directory (string-append state-directory "/cfg"))
(contexts-directory (string-append configuration-directory "/contexts"))
(groups-configuration (string-append configuration-directory "/groups.conf"))
(jobs-directory (string-append configuration-directory "/jobs")))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
;; Ensure configuration directory exists.
(mkdir-p #$configuration-directory)
;; Configure contexts.
(switch-symlinks #$contexts-directory
#$(laminar-contexts (forge-laminar-configuration-contexts config)))
;; Configure groups.
(switch-symlinks #$groups-configuration
#$(laminar-groups (forge-laminar-configuration-groups config)))
;; Create jobs directory and populate with job scripts.
(switch-symlinks #$jobs-directory
#$(laminar-jobs (forge-laminar-configuration-jobs config)))
;; 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))
;; Ensure the state directory has the right permissions so
;; that the nginx user can get in and serve files from the
;; archive directory. The state directory is the home of the
;; laminar user and is created with more restrictive
;; permissions. So, the permissions need to be overridden.
;; The archive directory, however, is always created with
;; the right permissions.
(chmod #$state-directory #o755)))))
(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)))
(contexts (append (forge-laminar-configuration-contexts config)
(filter forge-laminar-context? extended-values)))
(groups (append (forge-laminar-configuration-groups config)
(filter forge-laminar-group? extended-values))))))
(default-value (forge-laminar-configuration))))
