;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2021–2025 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2025 Frederick M. Muriithi <fredmanglis@protonmail.com>
;;;
;;; 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 forge)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module ((gnu packages ci) #:select (laminar))
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module ((gnu packages guile) #:select (guile-3.0 guile-bytestructures guile-zlib))
#:use-module ((gnu packages guile-xyz) #:select (guile-lib))
#:use-module ((gnu packages mail) #:select (msmtp))
#:use-module ((gnu packages nss) #:select (nss-certs))
#:use-module ((gnu packages package-management) #:select (guix))
#:use-module ((gnu packages version-control) #:select (git-minimal))
#:use-module (gnu services)
#:use-module (gnu services mcron)
#:use-module (gnu services web)
#:use-module (guix channels)
#:use-module (guix deprecation)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix store)
#:use-module ((forge guile-git) #:select (guile-git))
#:use-module (forge laminar)
#:use-module (forge nginx)
#:use-module (forge tissue)
#:use-module (forge utils)
#:use-module (forge webhook)
#:export (forge-service-type
forge-configuration
forge-configuration?
this-forge-configuration
forge-configuration-web-domain
forge-configuration-cgit-domain
forge-configuration-laminar-domain
forge-configuration-tissue-web-domain
forge-configuration-websites-directory
forge-configuration-web-root
forge-configuration-mailer-address
forge-configuration-projects
forge-project
forge-project?
this-forge-project
forge-project-name
forge-project-user
forge-project-repository
forge-project-repository-branch
forge-project-web-domain
forge-project-tissue?
forge-project-website-ci-job
forge-project-ci-jobs
forge-project-ci-jobs-trigger
forge-project-ci-notify-addresses
forge-project-parallel-ci-job-runs
derivation-job-gexp
variable-specification
variable-specification?
variable-specification-module
variable-specification-name
guix-channel-job-gexp))
(define-record-type* <forge-project>
forge-project make-forge-project
forge-project?
this-forge-project
(name forge-project-name)
;; The user field is optional because the repository may be remote
;; and not need to be owned by any user.
(user forge-project-user
(default #f))
(repository forge-project-repository)
(repository-branch forge-project-repository-branch
(default "main"))
(description forge-project-description
(default #f))
(web-domain forge-project-web-domain
(default #f))
(tissue? forge-project-tissue?
(default #f))
(website-ci-job forge-project-website-ci-job
(default #f)
(thunked))
(ci-jobs forge-project-ci-jobs
(default '()) (thunked))
(ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook
(default (cond
;; 'post-receive-hook for local repositories
((string-prefix? "/" (forge-project-repository this-forge-project))
'post-receive-hook)
;; 'cron for remote repositories
(else 'cron)))
(thunked))
(ci-notify-addresses forge-project-ci-notify-addresses
(default '()))
(parallel-ci-job-runs forge-project-parallel-ci-job-runs
(default 1)))
(define-record-type* <forge-configuration>
forge-configuration make-forge-configuration
forge-configuration?
this-forge-configuration
(web-domain forge-configuration-web-domain)
(cgit-domain forge-configuration-cgit-domain
(default #f))
(laminar-domain forge-configuration-laminar-domain
(default #f))
(tissue-web-domain forge-configuration-tissue-web-domain
(default #f))
(websites-directory forge-configuration-websites-directory
(default "/srv/http/forge"))
(web-root forge-configuration-web-root
(default (computed-file "forge-web-root"
(forge-web-root-gexp this-forge-configuration)))
(thunked))
(mailer-address forge-configuration-mailer-address
(default (string-append "mail@"
(forge-configuration-web-domain this-forge-configuration)))
(thunked))
(projects forge-configuration-projects
(default '())))
(define (forge-web-root-gexp config)
(with-extensions (list guile-lib)
#~(begin
(use-modules (rnrs io ports)
(srfi srfi-26)
(ice-9 match)
(htmlprag))
(define (laminar-badge job-name)
`(li (a (@ (href ,(string-append "https://"
#$(forge-configuration-laminar-domain config)
"/jobs/"
job-name)))
(img (@ (src ,(string-append "https://"
#$(forge-configuration-laminar-domain config)
"/badge/"
job-name
".svg")))))))
(mkdir #$output)
(let ((html
(sxml->html
`(html
(body
,@(map (match-lambda
((name description website-link jobs)
`((h2 ,(if website-link
`(a (@ (href ,website-link))
,name)
name))
,@(match jobs
(() '())
(_
(if #$(forge-configuration-laminar-domain config)
`((ul ,@(map laminar-badge jobs)))
'())))
,@(if description
`((p ,description))
'())
(ul
,@(if #$(forge-configuration-cgit-domain config)
`((li (a (@ (href ,(string-append "https://"
#$(forge-configuration-cgit-domain config)
"/" name "/")))
"cgit")))
'())))))
'#$(map (lambda (project)
(list (forge-project-name project)
(forge-project-description project)
(and (forge-project-website-ci-job project)
(if (forge-project-web-domain project)
(string-append "https://" (forge-project-web-domain project))
(string-append "/" (forge-project-name project) "/")))
(map forge-laminar-job-name
(forge-project-all-ci-jobs project config))))
(forge-configuration-projects config))))))))
(call-with-output-file (string-append #$output "/index.html")
(cut put-string <> html))))))
(define* (ci-jobs-trigger-gexp ci-jobs #:key reason)
"Return a G-expression that triggers CI-JOBS. CI-JOBS is a list of
<forge-laminar-job> objects."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
;; TODO: Only trigger on updates to the main/master branch.
;; Trigger jobs if there are jobs that need to be
;; triggered.
;;
;; Even if there are none, we still need to manage the
;; post-receive-hook to ensure that it does not go
;; stale. Suppose that in one generation the user configures
;; CI jobs, but removes them in the next generation. If we did
;; not write to the post-receive-hook in the second
;; generation, it would still retain its previous contents and
;; trigger the jobs from the first generation.
(match '#$(filter-map (lambda (job)
(and (forge-laminar-job-trigger? job)
(forge-laminar-job-name job)))
ci-jobs)
(() #t)
(job-names
(display "Triggering continuous integration jobs..." (current-error-port))
(newline (current-error-port))
(when #$reason
(setenv "LAMINAR_REASON" #$reason))
(apply invoke
#$(file-append laminar "/bin/laminarc")
"queue" job-names))))))
(define (forge-activation config)
(let ((projects
(map (lambda (project)
(list (forge-project-user project)
(forge-project-repository project)
(forge-project-description project)
(program-file
(string-append (forge-project-name project)
"-post-receive-hook")
(ci-jobs-trigger-gexp
(forge-project-all-ci-jobs project config)
#:reason "post-receive hook"))
(forge-project-ci-jobs-trigger project)))
(forge-configuration-projects config))))
#~(begin
(use-modules (rnrs io ports)
(srfi srfi-26)
(ice-9 match))
(define (find-regular-files dir)
(find-files dir (lambda (file stat)
(memq (stat:type stat)
'(regular directory)))
#:directories? #t))
;; Set ownership of forge websites directory.
(let ((user (getpw "laminar")))
(chown #$(forge-configuration-websites-directory config)
(passwd:uid user)
(passwd:gid user)))
(for-each (match-lambda
((username repository description ci-jobs-trigger ci-jobs-trigger-type)
;; For local repositories only
(when (string-prefix? "/" repository)
;; Set description.
(when description
(call-with-output-file (string-append repository "/description")
(cut put-string <> description)))
;; Set ownership of repository files when the
;; user field is set. This enables setups where
;; ownership is manually managed. TODO: Rethink
;; this when we move to repositories owned and
;; operated on by virtual users.
(when username
(for-each (lambda (file)
(let ((user (getpw username)))
(chown file (passwd:uid user) (passwd:gid user))))
(append (find-regular-files repository)))))
;; Install post receive hook.
(when (eq? ci-jobs-trigger-type 'post-receive-hook)
(let ((hook-link (string-append repository "/hooks/post-receive")))
(when (file-exists? hook-link)
(delete-file hook-link))
(symlink ci-jobs-trigger hook-link)))))
'#$projects))))
(define (import-module? name)
"Return #t if module NAME may be imported. Else, return #f."
(match name
(('forge _ ...) #t)
(name (guix-module-name? name))))
(define-deprecated (derivation-job-gexp project job gexp-producer
#:key (guix-daemon-uri (%daemon-socket-uri)) deep-clone?)
guix-channel-job-gexp
"Return a G-expression that builds another G-expression as a
derivation and returns its output path. GEXP-PRODUCER is a
G-expression that expands to a lambda function. The lambda function
takes one argument---the latest git checkout of PROJECT, a
<forge-project> object---and returns a G-expression describing a
derivation to run. JOB is a <forge-laminar-job> object representing
the job that this derivation will be part of.
GUIX_DAEMON_URI is a file name or URI designating the Guix daemon
endpoint.
If DEEP-CLONE? is #t, the git checkout is a deep clone of the
repository that includes the .git directory. Else, it is a shallow
clone and does not include the .git directory."
(with-imported-modules (source-module-closure '((forge build git)
(guix gexp)
(guix profiles))
#:select? import-module?)
(with-extensions (list guile-gcrypt guile-zlib)
(with-packages (list git-minimal nss-certs)
#~(begin
;; We pull out macros using module-ref and functions using
;; @@ instead of using use-modules because this gexp might
;; be substituted into other gexps and use-modules only
;; works at the top-level.
(let-syntax ((guard (macro-transformer
(module-ref (resolve-module '(rnrs exceptions))
'guard)))
(mbegin (macro-transformer
(module-ref (resolve-module '(guix monads))
'mbegin)))
(mlet* (macro-transformer
(module-ref (resolve-module '(guix monads))
'mlet*)))
(with-store (macro-transformer
(module-ref (resolve-module '(guix store))
'with-store)))
(return (identifier-syntax ((@@ (guix store) %store-monad)
%return))))
(let* ((latest-git-checkout (@@ (forge build git) latest-git-checkout))
(built-derivations (@@ (guix derivations) built-derivations))
(derivation->output-path (@@ (guix derivations) derivation->output-path))
(read-derivation-from-file (@@ (guix derivations) read-derivation-from-file))
(gexp->derivation (@@ (guix gexp) gexp->derivation))
(%daemon-socket-uri (@@ (guix store) %daemon-socket-uri))
(%store-monad (@@ (guix store) %store-monad))
(store-protocol-error? (@@ (guix store) store-protocol-error?))
(run-with-store (@@ (guix store) run-with-store))
(derivation-output
(parameterize ((%daemon-socket-uri #$guix-daemon-uri))
(with-store store
(guard (condition ((store-protocol-error? condition)
(exit #f)))
(run-with-store store
(mlet* %store-monad ((git-checkout (latest-git-checkout
#$(string-append (forge-project-name project)
"-checkout")
#$(forge-project-repository project)
#:deep-clone? #$deep-clone?
#:show-commit? #t))
(drv (gexp->derivation #$(string-append
(forge-laminar-job-name job)
"-derivation")
(#$gexp-producer git-checkout)
#:guile-for-build (read-derivation-from-file
#$(raw-derivation-file
(with-store store
(package-derivation store guile-3.0))))
#:substitutable? #f)))
(mbegin %store-monad
(built-derivations (list drv))
(return (derivation->output-path drv))))))))))
(format (current-error-port) "Built ~a successfully~%" derivation-output)
derivation-output)))))))
(define-record-type* <variable-specification>
variable-specification make-variable-specification
variable-specification?
(module variable-specification-module)
(name variable-specification-name))
(define* (guix-channel-job-gexp channels
#:key
variables
(guix-daemon-uri %daemon-socket-uri)
(verbose? #true))
"Return a G-expression that pulls @var{channels} and builds
@var{variables}, a list of @code{<variable-specification>} objects. If
@var{variables} is @code{#f}, all packages defined in the first
channel are built.
@var{guix-daemon-uri} is a file name or URI designating the Guix
daemon endpoint.
When @var{verbose?} is #true, verbose build logs are shown.
The return value of the returned G-expression is a list of store paths
that were built."
(with-extensions (list guix guile-bytestructures guile-gcrypt guile-git)
;; We pull out macros using module-ref and functions using @@
;; instead of using use-modules because this gexp might be
;; substituted into other gexps and use-modules only works at
;; the top-level.
#~(let-syntax ((guard (macro-transformer
(module-ref (resolve-module '(rnrs exceptions))
'guard)))
(let-values (macro-transformer
(module-ref (resolve-module '(srfi srfi-11))
'let-values)))
(match (macro-transformer
(module-ref (resolve-module '(ice-9 match))
'match)))
(match-lambda (macro-transformer
(module-ref (resolve-module '(ice-9 match))
'match-lambda)))
(with-status-verbosity (macro-transformer
(module-ref (resolve-module '(guix status))
'with-status-verbosity)))
(with-store (macro-transformer
(module-ref (resolve-module '(guix store))
'with-store)))
(mbegin (macro-transformer
(module-ref (resolve-module '(guix monads))
'mbegin))))
(let ((partition (@@ (srfi srfi-1) partition))
(list-transduce (@@ (srfi srfi-171) list-transduce))
(tmap (@@ (srfi srfi-171) tmap))
(tlog (@@ (srfi srfi-171) tlog))
(derivation-file-name (@@ (guix derivations) derivation-file-name))
(derivation->output-path (@@ (guix derivations) derivation->output-path))
(read-derivation-from-file (@@ (guix derivations) read-derivation-from-file))
(built-derivations (@@ (guix derivations) built-derivations))
(inferior-eval (@@ (guix inferior) inferior-eval))
(inferior-for-channels (@@ (guix inferior) inferior-for-channels))
(%daemon-socket-uri (@@ (guix store) %daemon-socket-uri))
(run-with-store (@@ (guix store) run-with-store))
(store-protocol-error? (@@ (guix store) store-protocol-error?))
(store-protocol-error-message (@@ (guix store) store-protocol-error-message))
(hline (lambda ()
(display (make-string 50 #\=))
(newline)))
(code->channel (lambda (code)
(eval code (resolve-module '(guix channels))))))
(setenv "SSL_CERT_DIR"
#$(file-append nss-certs "/etc/ssl/certs"))
(setenv "SSL_CERT_FILE"
#$(file-append (profile
(content (packages->manifest (list git-minimal nss-certs))))
"/etc/ssl/certs/ca-certificates.crt"))
(parameterize ((%daemon-socket-uri #$guix-daemon-uri))
(list-transduce
;; Build derivations and report success or failure.
(compose (tmap read-derivation-from-file)
(tmap (lambda (drv)
(cons drv
(guard (ex ((store-protocol-error? ex)
(store-protocol-error-message ex)))
(with-status-verbosity (if #$verbose? 1 0)
(with-store store
(run-with-store store
(mbegin %store-monad
(built-derivations (list drv))))))
#t))))
(tlog (lambda (_ input)
(match input
((drv . #t)
(format #t "Building ~a SUCCESS~%" (derivation-file-name drv)))
((drv . error-message)
(format #t "Building ~a FAILED~%" (derivation-file-name drv))
(display error-message)
(newline))))))
(case-lambda
(() (list))
((result)
;; Print summary.
(let-values (((successes failures) (partition (match-lambda
((_ . #t) #t)
(_ #f))
result)))
(newline)
(format #t "~a successes, ~a failures~%"
(length successes)
(length failures))
(hline)
(match failures
;; If no failures, return list of output paths.
(() (map (match-lambda
((drv . #t) (derivation->output-path drv)))
result))
;; If failures, list them.
(_
(newline)
(format #t "List of failures:~%")
(for-each (match-lambda
((drv . _)
(display (derivation-file-name drv))
(newline)))
failures)
(error "Failed to build derivations")))))
((result input)
(cons input result)))
;; Obtain list of derivations to build from inferior.
(let ((inferior (inferior-for-channels
(map code->channel '#$(map channel->code channels)))))
(inferior-eval '(use-modules (guix channels)
(guix describe)
(srfi srfi-1))
inferior)
(inferior-eval '(define (filter-packages pred)
(fold-packages (lambda (pkg result)
(if (pred pkg)
(cons pkg result)
result))
(list)))
inferior)
(inferior-eval
'(parameterize ((%daemon-socket-uri #$guix-daemon-uri))
(with-store store
(map (lambda (item)
(derivation-file-name
(parameterize ((%graft? #false))
(run-with-store store
(lower-object item)))))
#$(if variables
#~(map (match-lambda
((module-name variable-name)
(module-ref (resolve-module module-name)
variable-name)))
'#$(map (lambda (variable)
(list (variable-specification-module variable)
(variable-specification-name variable)))
variables))
#~(filter-packages
(lambda (pkg)
(any (lambda (channel)
(memq (channel-name channel)
(list '#$(channel-name (first channels)))))
(package-channels pkg))))))))
inferior))))))))
(define (switch-symlinks-gexp link target)
"Return a G-expression that links @var{link} to @var{target}. @var{target} is a
singleton list of targets as returned by @code{guix-channel-job-gexp}."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(switch-symlinks #$link
(match #$target
((target) target))))))
(define (forge-nginx-server-blocks config)
"Return list of @code{<nginx-server-configuration>} extensions for
forge configuration @var{config}."
(cons (nginx-server-configuration
(server-name (list (forge-configuration-web-domain config)))
(root (forge-configuration-web-root config))
;; Serve HTML files without extension.
(try-files (list "$uri" "$uri.html" "$uri/index.html" "=404"))
(locations
;; Configure location blocks for projects that have no web domain.
(filter-map (lambda (project)
(match-record project <forge-project>
(name web-domain)
(and (not web-domain)
(nginx-location-configuration
(uri (string-append "/" name "/"))
(body
(list (string-append "root "
(forge-configuration-websites-directory config)
";")))))))
(forge-configuration-projects config))))
;; Configure nginx server blocks for projects that have a web domain.
(filter-map (match-record-lambda <forge-project>
(name web-domain)
(and web-domain
(nginx-server-configuration
(server-name (list web-domain))
(root (string-append (forge-configuration-websites-directory config)
"/"
name))
;; Serve HTML files without extension.
(try-files (list "$uri" "$uri.html"
"$uri/index.html" "=404")))))
(forge-configuration-projects config))))
(define (forge-tissue-hosts config)
"Return list of @code{<tissue-host>} objects for forge configuration
@var{config}."
(match-record config <forge-configuration>
(tissue-web-domain projects)
;; Configure tissue host if a tissue web domain is provided.
(if tissue-web-domain
(list (tissue-host
(name tissue-web-domain)
(projects
(filter-map (lambda (project)
(and (forge-project-tissue? project)
(tissue-project
(name (forge-project-name project))
;; The laminar user must own the
;; host state so that it can run
;; tissue pull.
(user "laminar")
(upstream-repository
(forge-project-repository project)))))
projects))))
(list))))
(define (ci-notify-by-email from to)
"Return a G-expression that emails @var{to} addresses from @var{from} address
about the status of a laminar CI job. The returned G-expression is intended to
be used as the @code{after} field of a @code{<forge-laminar-job>} object."
#~(begin
(use-modules (ice-9 popen)
(srfi srfi-26))
(define (call-with-output-pipe command proc)
(let ((port #f))
(dynamic-wind
(cut set! port (apply open-pipe* OPEN_WRITE command))
(cut proc port)
(lambda ()
(unless (zero? (status:exit-val (close-pipe port)))
(error "Command invocation failed" command))))))
(let ((job (getenv "JOB"))
(run (getenv "RUN"))
(result (getenv "RESULT"))
(last-result (getenv "LAST_RESULT")))
(unless (string=? result last-result)
(call-with-output-pipe (list #$(file-append msmtp "/bin/msmtp")
"--host=localhost"
"--port=587"
"--read-envelope-from"
"--read-recipients")
(cut format
<>
"From: ~a
To: ~a
Subject: Laminar ~a #~a: ~a
See https://ci.systemreboot.net/jobs/~a/~a for details.
"
#$from
#$(string-join to ",")
job run result job run))))))
(define (forge-project-all-ci-jobs project config)
"Return list of all CI jobs for @var{project} in forge configuration
@var{config}."
(map (lambda (job)
(forge-laminar-job
(inherit job)
;; Add project context to job.
(contexts (cons (forge-project-name project)
(forge-laminar-job-contexts job)))
;; Add CI email notification to job.
(after #~(begin
#$@(cond
((forge-laminar-job-after job) => list)
(else (list)))
#$(match (forge-project-ci-notify-addresses project)
(() #f)
(addresses
(ci-notify-by-email (forge-configuration-mailer-address config)
addresses)))))))
;; Prepend website CI job to the other CI jobs.
(if (forge-project-website-ci-job project)
(cons (forge-laminar-job
(inherit (forge-project-website-ci-job project))
(run (switch-symlinks-gexp
(string-append (forge-configuration-websites-directory config)
"/"
(forge-project-name project))
(forge-laminar-job-run (forge-project-website-ci-job project)))))
(forge-project-ci-jobs project))
(forge-project-ci-jobs project))))
(define (forge-ci-jobs config)
"Return list of CI jobs for forge configuration @var{config}. Each
value of the returned list is a @code{<forge-laminar-job>} object."
(append-map (cut forge-project-all-ci-jobs <> config)
(forge-configuration-projects config)))
(define (forge-ci-job-contexts config)
"Return list of CI job contexts for forge configuration
@var{config}. Each element of the returned list is a
@code{<forge-laminar-context>} object."
(filter-map (lambda (project)
(forge-laminar-context
(name (forge-project-name project))
(executors (forge-project-parallel-ci-job-runs project))))
(forge-configuration-projects config)))
(define (forge-ci-job-groups config)
"Return list of CI job groups for forge configuration
@var{config}. Each element of the returned list is a
@code{<forge-laminar-group>} object."
(filter-map (lambda (project)
(match (forge-project-all-ci-jobs project config)
(() #f)
((job) #f)
(jobs
(forge-laminar-group
(name (forge-project-name project))
(regex (string-append "^(?:"
(string-join (map forge-laminar-job-name jobs)
"|")
")$"))))))
(forge-configuration-projects config)))
(define (forge-ci-jobs+contexts+groups config)
"Return list of CI jobs and job groups for forge configuration
@var{config}. Each element of the returned list is either a
@code{<forge-laminar-job>}, @code{<forge-laminar-context>} or
@code{<forge-laminar-group>} object."
(append (forge-ci-jobs config)
(forge-ci-job-contexts config)
(forge-ci-job-groups config)))
(define (forge-cron-jobs config)
"Return list of cron jobs for forge configuration @var{config}. Each
element of the returned list is a G-expression corresponding to an
mcron job specification."
(filter-map (lambda (project)
(and (eq? (forge-project-ci-jobs-trigger project)
'cron)
(any forge-laminar-job-trigger?
(forge-project-all-ci-jobs project config))
#~(job '(next-day)
#$(program-file
(string-append (forge-project-name project)
"-cron-job")
(ci-jobs-trigger-gexp
(forge-project-all-ci-jobs project config)
#:reason "Cron job"))
#:user "laminar")))
(forge-configuration-projects config)))
(define (forge-webhooks config)
"Return list of webhooks for forge configuration @var{config}. Return
value is a list of @code{<webhook-hook>} objects."
(filter-map (lambda (project)
(and (eq? (forge-project-ci-jobs-trigger project)
'webhook)
(any forge-laminar-job-trigger?
(forge-project-all-ci-jobs project config))
(webhook-hook
(id (forge-project-name project))
(run (ci-jobs-trigger-gexp
(forge-project-all-ci-jobs project config)
#:reason "Webhook")))))
(forge-configuration-projects config)))
(define forge-service-type
(service-type
(name 'forge)
(description "Run guix-forge.")
(extensions (list (service-extension activation-service-type
forge-activation)
(service-extension forge-nginx-service-type
forge-nginx-server-blocks)
(service-extension tissue-service-type
forge-tissue-hosts)
(service-extension forge-laminar-service-type
forge-ci-jobs+contexts+groups)
;; TODO: Run CI job only if there are new commits
;; in the remote repository.
(service-extension mcron-service-type
forge-cron-jobs)
(service-extension webhook-service-type
forge-webhooks)))
(compose concatenate)
(extend (lambda (config projects)
(forge-configuration
(inherit config)
(projects (append (forge-configuration-projects config)
projects)))))))
