Add (guix ci).
* guix/ci.scm: New file. * Makefile.am (MODULES): Add it.
This commit is contained in:
parent
733d66a532
commit
b3517f3f9f
@ -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 \
|
||||
|
78
guix/ci.scm
Normal file
78
guix/ci.scm
Normal file
@ -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)))
|
Loading…
Reference in New Issue
Block a user