1 files changed, 50 insertions, 0 deletions
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 <mail@cbaines.net>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+(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)))))))