cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add guix-data-service-request.

Browse source 
* guix-data-service/client.scm: New file.
* Makefile.am (SOURCES): Register file.
This commit is contained in:
Andreas Enge 2025-06-27 17:48:18 +02:00
parent beede72314
commit c63ba7f09c
2 changed files with 142 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -1,6 +1,7 @@
# guix-data-service -- Information about Guix over time
# Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
# Copyright © 2019 Christopher Baines <mail@cbaines.net>
# Copyright © 2025 Andreas Enge <andreas@enge.fr>
#
# 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 \

140
guix-data-service/client.scm Normal file
View file

@ -0,0 +1,140 @@
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2023, 2024, 2025 Christopher Baines <mail@cbaines.net>
;;;
;;; 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
;;; <http://www.gnu.org/licenses/>.
(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))))))