;;; guix-forge --- Guix software forge meta-service ;;; Copyright © 2021–2022, 2024 Arun Isaac ;;; ;;; 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 ;;; . (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 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 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 make-forge-laminar-context forge-laminar-context? (name forge-laminar-context-name) (executors forge-laminar-context-executors)) (define-record-type* 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{} 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{} 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{} 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)))))) (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))))