From c63ba7f09cf3c32c7fc84a974b1ab8f91609456f Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Fri, 27 Jun 2025 17:48:18 +0200 Subject: [PATCH] Add guix-data-service-request. * guix-data-service/client.scm: New file. * Makefile.am (SOURCES): Register file. --- Makefile.am | 2 + guix-data-service/client.scm | 140 +++++++++++++++++++++++++++++++++++ 2 files changed, 142 insertions(+) create mode 100644 guix-data-service/client.scm diff --git a/Makefile.am b/Makefile.am index 608293b..1875e97 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,7 @@ # guix-data-service -- Information about Guix over time # Copyright © 2016, 2017, 2018 Ricardo Wurmus # Copyright © 2019 Christopher Baines +# Copyright © 2025 Andreas Enge # # This file is part of guix-data-service. # @@ -71,6 +72,7 @@ SOURCES = \ guix-data-service/branch-updated-emails.scm \ guix-data-service/poll-git-repository.scm \ guix-data-service/builds.scm \ + guix-data-service/client.scm \ guix-data-service/comparison.scm \ guix-data-service/config.scm \ guix-data-service/database.scm \ diff --git a/guix-data-service/client.scm b/guix-data-service/client.scm new file mode 100644 index 0000000..23690bd --- /dev/null +++ b/guix-data-service/client.scm @@ -0,0 +1,140 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2023, 2024, 2025 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program 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 +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service client) + #:use-module (srfi srfi-71) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:use-module (json) + #:use-module (knots non-blocking) + #:use-module (web client) + #:use-module (web uri) + #:use-module (web response) + #:use-module (zlib) + #:use-module ((guix-build-coordinator utils fibers) #:select (retry-on-error)) + #:export (http-get* + guix-data-service-request)) + +(define-exception-type &guix-data-service-error &error + make-guix-data-service-error + guix-data-service-error? + (response-body guix-data-service-error-response-body) + (response-code guix-data-service-error-response-code)) + + +(define* (http-get* uri + #:key + (method 'GET) + (body #f) + (verify-certificate? #t) + (port #f) + (version '(1 . 1)) + (keep-alive? #f) + (headers '()) + (decode-body? #t) + ;; Default to streaming? #t since read-response-body calls + ;; get-bytevector-all, which is implemented in C and + ;; therefore can't be suspended + (streaming? #t)) + (let ((port + (non-blocking-open-socket-for-uri + uri + #:verify-certificate? verify-certificate?))) + (http-request uri + #:method method + #:body body + #:verify-certificate? verify-certificate? + #:port port + #:version version + #:keep-alive? keep-alive? + #:headers headers + #:decode-body? decode-body? + #:streaming? streaming?))) + + +(define* (guix-data-service-request guix-data-service + path + #:optional (query-parameters '()) + #:key (retry-times 3) (retry-delay 60)) + (define uri + (string->uri (string-append + guix-data-service + path + (if (null? query-parameters) + "" + (string-append + "?" + (string-join + (map (match-lambda + ((key . value) + (simple-format #f "~A=~A" key value))) + query-parameters) + "&")))))) + + (define (make-request) + (let ((response + body + (http-get* uri + #:headers + '((accept-encoding . ((1 . "gzip")))) + #:streaming? #t))) + (cond + ((eq? (response-code response) 404) #f) + ((>= (response-code response) 400) + (let ((json-body + (with-exception-handler + (lambda (exn) + 'error-decoding-body) + (lambda () + (match (response-content-encoding response) + (('gzip) + (let ((zlib-input + (make-zlib-input-port body + #:format 'gzip))) + (json->scm zlib-input))) + (_ + (json->scm body)))) + #:unwind? #t))) + (raise-exception + (make-guix-data-service-error json-body + (response-code response))))) + (else + (let ((json-body + (match (response-content-encoding response) + (('gzip) + (let ((zlib-input + (make-zlib-input-port body + #:format 'gzip))) + (json->scm zlib-input))) + (_ + (json->scm body))))) + (values json-body + response)))))) + + (if (= 0 retry-times) + (make-request) + (retry-on-error + make-request + #:times retry-times + #:delay-seconds retry-delay + #:no-retry (lambda (exn) + (and (guix-data-service-error? exn) + (not + (= (guix-data-service-error-response-code exn) + 429)) + (< (guix-data-service-error-response-code exn) + 500))))))