diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-06-01 11:29:11 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-06-01 11:29:11 +0100 |
| commit | 27b761a1ca7c3e68c6d31a2260dff12fbad5f49f (patch) | |
| tree | 8c4e4f1c74f081f516ae35b636d3050b997ee748 | |
| parent | acffb47ffdb10e3c74e48a76db76efe1bc3c0909 (diff) | |
| download | qa-frontpage-27b761a1ca7c3e68c6d31a2260dff12fbad5f49f.tar qa-frontpage-27b761a1ca7c3e68c6d31a2260dff12fbad5f49f.tar.gz | |
Use a single connection for mumi-bulk-issues
As this might upset the MDC firewall less.
| -rw-r--r-- | guix-qa-frontpage/mumi.scm | 97 |
1 files changed, 69 insertions, 28 deletions
diff --git a/guix-qa-frontpage/mumi.scm b/guix-qa-frontpage/mumi.scm index a1f5326..9960cab 100644 --- a/guix-qa-frontpage/mumi.scm +++ b/guix-qa-frontpage/mumi.scm @@ -19,8 +19,12 @@ (define-module (guix-qa-frontpage mumi) #:use-module (srfi srfi-1) #:use-module (ice-9 match) + #:use-module (json) #:use-module (kolam http) - #:use-module ((guix-data-service utils) #:select (chunk-for-each!)) + #:use-module (kolam parse) + #:use-module (web uri) + #:use-module (web client) + #:use-module ((guix-data-service utils) #:select (chunk!)) #:use-module ((guix-build-coordinator utils) #:select (retry-on-error)) #:export (mumi-search-issues @@ -31,6 +35,32 @@ mumi-bulk-issues)) +(define* (graphql-http-get* + uri document + #:key (verify-certificate? #t) + (port (open-socket-for-uri + uri + #:verify-certificate? verify-certificate?)) + (keep-alive? #f) + (variables '())) + (call-with-values + (lambda () + (http-get + (string-append uri + "?query=" + (uri-encode (scm->graphql-string document)) + "&" + "variables=" + (uri-encode (scm->json-string + ((@@ (kolam http) variables->alist) + variables)))) + #:streaming? #t + #:keep-alive? keep-alive? + #:verify-certificate? verify-certificate? + #:port port)) + (@@ (kolam http) graphql-http-response))) + + (define (mumi-search-issues query) (with-exception-handler (lambda (exn) @@ -61,37 +91,48 @@ "open"))) (define (mumi-bulk-issues numbers) + (define url + "https://issues.guix.gnu.org/graphql") + (let ((number-to-data (make-hash-table))) - (chunk-for-each! - (lambda (chunk) - (let ((response - (retry-on-error - (lambda () - (graphql-http-get - "https://issues.guix.gnu.org/graphql" - `(document - ,@(map (lambda (number) - `(query (#(issue #:number ,number) - number title open severity tags))) - chunk)))) - #:times 3 - #:delay 0))) + (let loop ((chunks (chunk! (list-copy numbers) + 30)) + (port + (open-socket-for-uri + (string->uri url) + #:verify-certificate? #t))) + (if (null? chunks) + (close-port port) + (let ((response + (retry-on-error + (lambda () + (graphql-http-get* + url + `(document + ,@(map (lambda (number) + `(query (#(issue #:number ,number) + number title open severity tags))) + (car chunks))) + #:keep-alive? #t + #:port port)) + #:times 3 + #:delay 0))) + + (for-each + (lambda (res) + (let ((data (cdr res))) + (hash-set! number-to-data + (assoc-ref data "number") + `((title . ,(assoc-ref data "title")) + (open? . ,(assoc-ref data "open")) + (tags . ,(vector->list + (assoc-ref data "tags"))) + (severity . ,(assoc-ref data "severity")))))) + response) - (for-each - (lambda (res) - (let ((data (cdr res))) - (hash-set! number-to-data - (assoc-ref data "number") - `((title . ,(assoc-ref data "title")) - (open? . ,(assoc-ref data "open")) - (tags . ,(vector->list - (assoc-ref data "tags"))) - (severity . ,(assoc-ref data "severity")))))) - response))) - 30 - (list-copy numbers)) + (loop (cdr chunks) port)))) (map (lambda (number) (hash-ref number-to-data number)) |