From e9bf51108272977d61a34e1af753f5064f0d57c7 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 22 Jan 2021 09:44:45 +0100 Subject: services: cuirass: Add "simple-cuirass-services". * gnu/services/cuirass.scm (, ): New records. (build-manifest, build-manifest?, simple-cuirass-configuration, simple-cuirass-configuration?, simple-cuirass-services): New procedures. (%default-cuirass-config): New variable. * gnu/tests/cuirass.scm (%cuirass-simple-test): New variable. * doc/guix.texi (Continuous Integration): Document it. --- gnu/services/cuirass.scm | 102 ++++++++++++++++++++++++++++++++++++++++++++++- gnu/tests/cuirass.scm | 28 ++++++++++++- 2 files changed, 128 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index ea656c617e..99edd3d13e 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -22,11 +22,13 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services cuirass) + #:use-module (guix channels) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix utils) #:use-module (gnu packages admin) #:use-module (gnu packages ci) + #:use-module (gnu packages databases) #:use-module (gnu packages version-control) #:use-module (gnu services) #:use-module (gnu services base) @@ -34,6 +36,8 @@ #:use-module (gnu services shepherd) #:use-module (gnu services admin) #:use-module (gnu system shadow) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:export ( cuirass-remote-server-configuration cuirass-remote-server-configuration? @@ -46,7 +50,18 @@ cuirass-remote-worker-configuration cuirass-remote-worker-configuration? - cuirass-remote-worker-service-type)) + cuirass-remote-worker-service-type + + + build-manifest + build-manifest? + + + simple-cuirass-configuration + simple-cuirass-configuration? + + %default-cuirass-config + simple-cuirass-services)) ;;;; Commentary: ;;; @@ -373,3 +388,88 @@ CONFIG." cuirass-remote-worker-shepherd-service))) (description "Run the Cuirass remote build worker service."))) + +(define-record-type* + build-manifest make-build-manifest + build-manifest? + (channel-name build-manifest-channel-name) ;symbol + (manifest build-manifest-manifest)) ;string + +(define-record-type* + simple-cuirass-configuration make-simple-cuirass-configuration + simple-cuirass-configuration? + (build simple-cuirass-configuration-build + (default 'all)) ;symbol or list of + (channels simple-cuirass-configuration-channels + (default %default-channels)) ;list of + (non-package-channels simple-cuirass-configuration-package-channels + (default '())) ;list of channels name + (systems simple-cuirass-configuration-systems + (default (list (%current-system))))) ;list of strings + +(define %default-cuirass-config + (cuirass-configuration + (specifications #~()))) + +(define* (simple-cuirass-services config + #:optional + (cuirass %default-cuirass-config)) + (define (format-name name) + (if (string? name) + name + (symbol->string name))) + + (define (format-manifests build-manifests) + (map (lambda (build-manifest) + (match-record build-manifest + (channel-name manifest) + (cons (format-name channel-name) manifest))) + build-manifests)) + + (define (channel->input channel) + (let ((name (channel-name channel)) + (url (channel-url channel)) + (branch (channel-branch channel))) + `((#:name . ,(format-name name)) + (#:url . ,url) + (#:load-path . ".") + (#:branch . ,branch) + (#:no-compile? #t)))) + + (define (package-path channels non-package-channels) + (filter-map (lambda (channel) + (let ((name (channel-name channel))) + (and (not (member name non-package-channels)) + (not (eq? name 'guix)) + (format-name name)))) + channels)) + + (define (config->spec config) + (match-record config + (build channels non-package-channels systems) + `((#:name . "simple-config") + (#:load-path-inputs . ("guix")) + (#:package-path-inputs . ,(package-path channels + non-package-channels)) + (#:proc-input . "guix") + (#:proc-file . "build-aux/cuirass/gnu-system.scm") + (#:proc . cuirass-jobs) + (#:proc-args . ((systems . ,systems) + ,@(if (eq? build 'all) + '() + `((subset . "manifests") + (manifests . ,(format-manifests build)))))) + (#:inputs . ,(map channel->input channels)) + (#:build-outputs . ()) + (#:priority . 1)))) + + (list + (service cuirass-service-type + (cuirass-configuration + (inherit cuirass) + (specifications #~(list + '#$(config->spec config))))) + (service postgresql-service-type + (postgresql-configuration + (postgresql postgresql-10))) + (service postgresql-role-service-type))) diff --git a/gnu/tests/cuirass.scm b/gnu/tests/cuirass.scm index 760aef8245..22eab3c456 100644 --- a/gnu/tests/cuirass.scm +++ b/gnu/tests/cuirass.scm @@ -35,7 +35,8 @@ #:use-module (guix gexp) #:use-module (guix store) #:export (%cuirass-test - %cuirass-remote-test)) + %cuirass-remote-test + %cuirass-simple-test)) (define %derivation-file (scheme-file @@ -284,3 +285,28 @@ (name "cuirass-remote") (description "Connect to a Cuirass server with remote build.") (value (run-cuirass-test name os))))) + +(define %cuirass-simple-test + (let ((os (operating-system + (inherit %simple-os) + (services + (append + (list cow-service + (service dhcp-client-service-type) + git-service) + (simple-cuirass-services + (simple-cuirass-configuration + (build 'all) + (channels (list (channel + (name 'guix) + (url "file:///tmp/cuirass-main/"))))) + (cuirass-configuration + (inherit %default-cuirass-config) + (host "0.0.0.0") + (use-substitutes? #t))) + (operating-system-user-services %simple-os)))))) + (system-test + (name "cuirass-simple") + (description "Connect to a simple Cuirass server.") + (value + (run-cuirass-test name os))))) -- cgit v1.2.3