From 5e61bc03b4f33ebb7378a3647bde6269b70c99fb Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 28 Jun 2020 22:28:22 +0100 Subject: Add a function to notify the Guix Data Service about build events --- Makefile.am | 1 + guix-build-coordinator/guix-data-service.scm | 50 ++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+) create mode 100644 guix-build-coordinator/guix-data-service.scm diff --git a/Makefile.am b/Makefile.am index 59af3c8..d73488b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -16,6 +16,7 @@ SOURCES = \ guix-build-coordinator/datastore/abstract.scm \ guix-build-coordinator/datastore/postgresql.scm \ guix-build-coordinator/datastore/sqlite.scm \ + guix-build-coordinator/guix-data-service.scm \ guix-build-coordinator/hooks.scm \ guix-build-coordinator/metrics.scm \ guix-build-coordinator/utils.scm diff --git a/guix-build-coordinator/guix-data-service.scm b/guix-build-coordinator/guix-data-service.scm new file mode 100644 index 0000000..d777b49 --- /dev/null +++ b/guix-build-coordinator/guix-data-service.scm @@ -0,0 +1,50 @@ +;;; Guix Build Coordinator +;;; +;;; Copyright © 2020 Christopher Baines +;;; +;;; This file is part of the guix-build-coordinator. +;;; +;;; The Guix Build Coordinator 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. +;;; +;;; The Guix Build Coordinator 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 the guix-data-service. If not, see +;;; . + +(define-module (guix-build-coordinator guix-data-service) + #:use-module (srfi srfi-11) + #:use-module (ice-9 exceptions) + #:use-module (rnrs bytevectors) + #:use-module (json) + #:use-module (web client) + #:use-module (web response) + #:export (send-build-event-to-guix-data-service)) + +(define (send-build-event-to-guix-data-service target-url event) + (define body + (scm->json-string + `((items . ,(vector event))))) + + (let*-values + (((response body) + (http-post target-url + #:body body + ;; Guile doesn't treat JSON as text, so decode the + ;; body manually + #:decode-body? #f)) + ((code) + (response-code response))) + (unless (and (>= code 200) + (< code 300)) + (raise-exception + (make-exception-with-message + (simple-format #f "code: ~A response: ~A" + code + (utf8->string body))))))) -- cgit v1.2.3