diff options
author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2018-03-28 15:44:29 +0200 |
---|---|---|
committer | Ludovic Courtès <ludovic.courtes@inria.fr> | 2018-03-28 16:17:06 +0200 |
commit | b3517f3f9f5815686600fb45a4e2350e168c0d54 (patch) | |
tree | ebd2ffde1a611d7b9d684e000658eff8ba4b6e30 | |
parent | 733d66a532d08dd0a2d717830345f977aba41815 (diff) | |
download | guix-b3517f3f9f5815686600fb45a4e2350e168c0d54.tar.gz |
Add (guix ci).
* guix/ci.scm: New file. * Makefile.am (MODULES): Add it.
-rw-r--r-- | Makefile.am | 1 | ||||
-rw-r--r-- | guix/ci.scm | 78 |
2 files changed, 79 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index feb99490d3..e50d8430e5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -115,6 +115,7 @@ MODULES = \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ guix/http-client.scm \ + guix/ci.scm \ guix/gnupg.scm \ guix/elf.scm \ guix/profiling.scm \ diff --git a/guix/ci.scm b/guix/ci.scm new file mode 100644 index 0000000000..881f3d3927 --- /dev/null +++ b/guix/ci.scm @@ -0,0 +1,78 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix ci) + #:use-module (guix http-client) + #:autoload (json parser) (json->scm) + #:use-module (srfi srfi-9) + #:export (build? + build-id + build-derivation + build-system + build-status + build-timestamp + + %query-limit + queued-builds + latest-builds)) + +;;; Commentary: +;;; +;;; This module provides a client to the HTTP interface of the Hydra and +;;; Cuirass continuous integration (CI) tools. +;;; +;;; Code: + +(define-record-type <build> + (make-build id derivation system status timestamp) + build? + (id build-id) ;integer + (derivation build-derivation) ;string | #f + (system build-system) ;string + (status build-status) ;integer + (timestamp build-timestamp)) ;integer + +(define %query-limit + ;; Max number of builds requested in queries. + 1000) + +(define (json-fetch url) + (let* ((port (http-fetch url)) + (json (json->scm port))) + (close-port port) + json)) + +(define (json->build json) + (make-build (hash-ref json "id") + (hash-ref json "derivation") + (hash-ref json "system") + (hash-ref json "buildstatus") + (hash-ref json "timestamp"))) + +(define* (queued-builds url #:optional (limit %query-limit)) + "Return the list of queued derivations on URL." + (let ((queue (json-fetch (string-append url "/api/queue?nr=" + (number->string limit))))) + (map json->build queue))) + +(define* (latest-builds url #:optional (limit %query-limit)) + (let ((latest (json-fetch (string-append url "/api/latestbuilds?nr=" + (number->string limit))))) + ;; Note: Hydra does not provide a "derivation" field for entries in + ;; 'latestbuilds', but Cuirass does. + (map json->build latest))) |