diff options
| -rw-r--r-- | guix/import/cpan.scm | 9 | ||||
| -rw-r--r-- | guix/import/crate.scm | 4 | ||||
| -rw-r--r-- | guix/import/gem.scm | 2 | ||||
| -rw-r--r-- | guix/import/github.scm | 19 | ||||
| -rw-r--r-- | guix/import/json.scm | 24 | ||||
| -rw-r--r-- | guix/import/pypi.scm | 4 | ||||
| -rw-r--r-- | guix/import/stackage.scm | 2 |
7 files changed, 30 insertions, 34 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 58c051e283..08bed8767c 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -88,9 +88,10 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/" - module - "?fields=distribution")) + (assoc-ref (json-fetch-alist (string-append + "https://fastapi.metacpan.org/v1/module/" + module + "?fields=distribution")) "distribution")) (define (package->upstream-name package) @@ -113,7 +114,7 @@ return \"Test-Simple\"" "Return an alist representation of the CPAN metadata for the perl module MODULE, or #f on failure. MODULE should be e.g. \"Test::Script\"" ;; This API always returns the latest release of the module. - (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name))) + (json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name))) (define (cpan-home name) (string-append "http://search.cpan.org/dist/" name "/")) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index a7485bb4d0..3724a457a4 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -51,7 +51,7 @@ (define (crate-kind-predicate kind) (lambda (dep) (string=? (assoc-ref dep "kind") kind))) - (and-let* ((crate-json (json-fetch (string-append crate-url crate-name))) + (and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name))) (crate (assoc-ref crate-json "crate")) (name (assoc-ref crate "name")) (version (assoc-ref crate "max_version")) @@ -63,7 +63,7 @@ string->license) '())) ;missing license info (path (string-append "/" version "/dependencies")) - (deps-json (json-fetch (string-append crate-url name path))) + (deps-json (json-fetch-alist (string-append crate-url name path))) (deps (assoc-ref deps-json "dependencies")) (input-crates (filter (crate-kind-predicate "normal") deps)) (native-input-crates diff --git a/guix/import/gem.scm b/guix/import/gem.scm index 6e914d6290..646163fb7b 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -38,7 +38,7 @@ (define (rubygems-fetch name) "Return an alist representation of the RubyGems metadata for the package NAME, or #f on failure." - (json-fetch + (json-fetch-alist (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) (define (ruby-package-name name) diff --git a/guix/import/github.scm b/guix/import/github.scm index 4b7d53c704..ef226911b9 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -22,31 +22,16 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:use-module (json) #:use-module (guix utils) #:use-module ((guix download) #:prefix download:) #:use-module (guix import utils) + #:use-module (guix import json) #:use-module (guix packages) #:use-module (guix upstream) #:use-module (guix http-client) #:use-module (web uri) #:export (%github-updater)) -(define (json-fetch* url) - "Return a representation of the JSON resource URL (a list or hash table), or -#f if URL returns 403 or 404." - (guard (c ((and (http-get-error? c) - (let ((error (http-get-error-code c))) - (or (= 403 error) - (= 404 error)))) - #f)) ;; "expected" if there is an authentification error (403), - ;; or if package is unknown (404). - ;; Note: github.com returns 403 if we omit a 'User-Agent' header. - (let* ((port (http-fetch url)) - (result (json->scm port))) - (close-port port) - result))) - (define (find-extension url) "Return the extension of the archive e.g. '.tar.gz' given a URL, or false if none is recognized" @@ -144,7 +129,7 @@ the package e.g. 'bedtools2'. Return #f if there is no releases" "https://api.github.com/repos/" (github-user-slash-repository url) "/releases")) - (json (json-fetch* + (json (json-fetch (if token (string-append api-url "?access_token=" token) api-url)))) diff --git a/guix/import/json.scm b/guix/import/json.scm index c76bc9313c..3f2ab1e3ea 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -22,15 +22,25 @@ #:use-module (guix http-client) #:use-module (guix import utils) #:use-module (srfi srfi-34) - #:export (json-fetch)) + #:export (json-fetch + json-fetch-alist)) (define (json-fetch url) - "Return an alist representation of the JSON resource URL, or #f on failure." + "Return a representation of the JSON resource URL (a list or hash table), or +#f if URL returns 403 or 404." (guard (c ((and (http-get-error? c) - (= 404 (http-get-error-code c))) - #f)) ;"expected" if package is unknown - (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile") - (Accept . "application/json")))) - (result (hash-table->alist (json->scm port)))) + (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")))) + (result (json->scm port))) (close-port port) result))) + +(define (json-fetch-alist url) + "Return an alist representation of the JSON resource URL, or #f if URL +returns 403 or 404." + (hash-table->alist (json-fetch url))) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index bb0db1ba85..6beab6b010 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -51,8 +51,8 @@ (define (pypi-fetch name) "Return an alist representation of the PyPI metadata for the package NAME, or #f on failure." - (json-fetch (string-append "https://pypi.python.org/pypi/" - name "/json"))) + (json-fetch-alist (string-append "https://pypi.python.org/pypi/" + name "/json"))) ;; For packages found on PyPI that lack a source distribution. (define-condition-type &missing-source-error &error diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 5b25adc674..ec93fbced6 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -60,7 +60,7 @@ (let* ((url (if (string=? "" version) (string-append %stackage-url "/lts") (string-append %stackage-url "/lts-" version))) - (lts-info (json-fetch url))) + (lts-info (json-fetch-alist url))) (if lts-info (reverse lts-info) (leave-with-message "LTS release version not found: ~a" version)))))) |