02/06: import: github: Request API v3 in the 'Accept' header.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 2766282f5a91f4a2739cfc3fce0dee7c7ec9e5cc
Author: Ludovic Courtès <address@hidden>
Date:   Mon Aug 20 15:11:14 2018 +0200

    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'.
---
 guix/import/github.scm |  9 +++++++--
 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 ef22691..d7a673e 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 <address@hidden>
-;;; Copyright © 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017, 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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 3f2ab1e..4f96a51 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 <address@hidden>
 ;;; Copyright © 2015, 2016 Eric Bavier <address@hidden>
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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)))