diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-08-20 15:11:14 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-08-20 16:32:18 +0200 |
| commit | 2766282f5a91f4a2739cfc3fce0dee7c7ec9e5cc (patch) | |
| tree | 5fea0000274e984c0f61903dbb5650bda5d5ee6b | |
| parent | a50eed201bf470b3bd124a2983bcea3453ec698f (diff) | |
| download | guix-2766282f5a91f4a2739cfc3fce0dee7c7ec9e5cc.tar.gz | |
import: github: Request API v3 in the 'Accept' header.
* guix/import/json.scm (json-fetch): Add #:headers argument and honor it. * guix/import/github.scm (latest-released-version): Pass #:headers to 'json-fetch'.
| -rw-r--r-- | guix/import/github.scm | 9 | ||||
| -rw-r--r-- | guix/import/json.scm | 14 |
2 files changed, 16 insertions, 7 deletions
diff --git a/guix/import/github.scm b/guix/import/github.scm index ef226911b9..d7a673e8d6 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -132,7 +132,12 @@ the package e.g. 'bedtools2'. Return #f if there is no releases" (json (json-fetch (if token (string-append api-url "?access_token=" token) - api-url)))) + api-url) + #:headers + ;; Ask for version 3 of the API as suggested at + ;; <https://developer.github.com/v3/>. + `((Accept . "application/vnd.github.v3+json") + (user-agent . "GNU Guile"))))) (if (eq? json #f) (if token (error "Error downloading release information through the GitHub diff --git a/guix/import/json.scm b/guix/import/json.scm index 3f2ab1e3ea..4f96a513df 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,17 +26,20 @@ #:export (json-fetch json-fetch-alist)) -(define (json-fetch url) +(define* (json-fetch url + ;; Note: many websites returns 403 if we omit a + ;; 'User-Agent' header. + #:key (headers `((user-agent . "GNU Guile") + (Accept . "application/json")))) "Return a representation of the JSON resource URL (a list or hash table), or -#f if URL returns 403 or 404." +#f if URL returns 403 or 404. HEADERS is a list of HTTP headers to pass in +the query." (guard (c ((and (http-get-error? c) (let ((error (http-get-error-code c))) (or (= 403 error) (= 404 error)))) #f)) - ;; Note: many websites returns 403 if we omit a 'User-Agent' header. - (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile") - (Accept . "application/json")))) + (let* ((port (http-fetch url #:headers headers)) (result (json->scm port))) (close-port port) result))) |