summary refs log tree commit diff
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-01-22 09:44:45 +0100
committerMathieu Othacehe <othacehe@gnu.org>2021-02-19 20:10:09 +0100
commite9bf51108272977d61a34e1af753f5064f0d57c7 (patch)
treed7134468689b93802403b578271672db064eba2e
parent25ad6e1d8ee268bbf57a48481467a1b13a4fbbb2 (diff)
downloadguix-e9bf51108272977d61a34e1af753f5064f0d57c7.tar.gz
services: cuirass: Add "simple-cuirass-services".
* gnu/services/cuirass.scm (<build-manifest>,
<simple-cuirass-configuration>): 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.
-rw-r--r--doc/guix.texi102
-rw-r--r--gnu/services/cuirass.scm102
-rw-r--r--gnu/tests/cuirass.scm28
3 files changed, 230 insertions, 2 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 5d28fca837..30e9b052e0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -27133,6 +27133,108 @@ The Cuirass package to use.
 @end table
 @end deftp
 
+@cindex simple cuirass
+@subsubheading Simple Cuirass
+
+The Cuirass service configuration described above can be a little
+intimidating.  The @code{simple-cuirass-services} procedure offers a way
+to setup a continuous integration server more readily.
+
+It takes a @code{simple-cuirass-configuration} record as its first
+argument.
+
+@deftp {Data Type} simple-cuirass-configuration
+Data type representing the configuration of a simple Cuirass instance.
+
+@table @asis
+@item @code{build} (default: @code{'all})
+The packages to be built by Cuirass.  It defaults to @code{'all}, which
+means that all the discovered packages in the subsequent @code{channels}
+field are to be selected.
+
+It is also possible to set this field to a list of @code{build-manifest}
+records, so that only the packages that are part of the declared
+manifests are built.  This record is described below.
+
+@deftp {Data Type} build-manifest
+@table @asis
+@item @code{channel-name}
+The name of the channel where the manifest is located.
+
+@item @code{manifest}
+The manifest path inside the channel.
+
+@end table
+@end deftp
+
+@item @code{channels} (default: @code{%default-channels})
+The channels to be fetched by Cuirass, see @pxref{Channels}.
+
+@item @code{non-package-channels} (default: @code{'()})
+List the channel names that must not be searched for packages.  That is
+often the case for the channel containing the manifest.
+
+@item @code{systems} (default: @code{(list (%current-system))})
+Build every discovered package for each system in this list.  By default
+only the current system is selected.
+
+@end table
+@end deftp
+
+Here is an example of how to setup a Cuirass instance that builds all
+the packages declared by Guix and a user repository.  The package list
+is re-evaluated each time a commit is pushed in one of the declared
+channels.
+
+@lisp
+(simple-cuirass-services
+ (simple-cuirass-configuration
+  (build 'all)
+  (channels (cons (channel
+                   (name 'my-guix)
+                   (url "https://my-git-repo/guix.git"))
+                  %default-channels))))
+@end lisp
+
+In the same spirit, this builds all the packages that are part of the
+@code{'guix} or @code{'my-guix} channels and declared in the manifest
+located in the @code{'conf} channel.
+
+@lisp
+(simple-cuirass-services
+ (simple-cuirass-configuration
+  (build (list
+          (build-manifest
+           (channel-name 'conf)
+           (manifest "guix/manifest.scm"))))
+  (channels (cons* (channel
+                    (name 'my-guix)
+                    (url "https://my-git-repo/guix.git"))
+                   (channel
+                    (name 'conf)
+                    (url "https://my-git-repo/conf.git"))
+                   %default-channels))
+  (non-package-channels '(conf))))
+@end lisp
+
+Finally, @code{simple-cuirass-services} takes as a second optional
+argument a @code{cuirass-configuration} record.  It can be used to
+customize the configuration of the Cuirass instance.
+
+@lisp
+(simple-cuirass-services
+ (simple-cuirass-configuration
+  (build 'all)
+  (channels (cons (channel
+                   (name 'my-guix)
+                   (url "https://my-git-repo/guix.git"))
+                  %default-channels))
+  (non-package-channels '(conf)))
+ (cuirass-configuration
+  (inherit %default-cuirass-config)
+  (host "0.0.0.0"))) ;listen on all interfaces.
+@end lisp
+
 @node Power Management Services
 @subsection Power Management Services
 
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 <http://www.gnu.org/licenses/>.
 
 (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
             cuirass-remote-server-configuration?
@@ -46,7 +50,18 @@
             <cuirass-remote-worker-configuration>
             cuirass-remote-worker-configuration
             cuirass-remote-worker-configuration?
-            cuirass-remote-worker-service-type))
+            cuirass-remote-worker-service-type
+
+            <build-manifest>
+            build-manifest
+            build-manifest?
+
+            <simple-cuirass-configuration>
+            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>
+  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>
+  simple-cuirass-configuration make-simple-cuirass-configuration
+  simple-cuirass-configuration?
+  (build                 simple-cuirass-configuration-build
+                         (default 'all))  ;symbol or list of <build-manifest>
+  (channels              simple-cuirass-configuration-channels
+                         (default %default-channels))  ;list of <channel>
+  (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 <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 <simple-cuirass-configuration>
+      (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)))))