mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-13 10:30:43 +02:00
Code Releases Activity

import: nuget: use json-fetch.

Browse source 
* guix/import/nuget.scm (nuget-find-best-version-for-range):
(nuget-fetch-catalog-entry): Use json-fetch.

Change-Id: I5223d264d363004aacfb0cf4a522813ffa485893
Reviewed-by: Danny Milosavljevic <dannym@friendly-machines.com>
Signed-off-by: Sharlatan Hellseher <sharlatanus@gmail.com>
This commit is contained in:
Zheng Junjie 2025-06-19 23:03:13 +08:00 • committed by Sharlatan Hellseher
parent 2e6c177149
commit 8b38fb8fa7
No known key found for this signature in database
GPG key ID: 76D727BFF62CD2B5
1 changed files with 43 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

29
guix/import/nuget.scm
View file

@ -29,7 +29,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module ((rnrs) #:select (open-bytevector-input-port put-bytevector)) #:use-module ((rnrs) #:select (put-bytevector))
#:use-module ((sxml xpath) #:select (sxpath)) ; filter... grr #:use-module ((sxml xpath) #:select (sxpath)) ; filter... grr
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
@ -51,6 +51,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix import utils) #:use-module ((guix import utils)
#:select (factorize-uri snake-case recursive-import flatten)) #:select (factorize-uri snake-case recursive-import flatten))
#:use-module (guix import json)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix git) #:use-module (guix git)
@ -149,10 +150,9 @@ primitives suitable for the 'semver-range' constructor."
creation and filtering to avoid type errors." creation and filtering to avoid type errors."
(let* ((name-lower (string-downcase name)) (let* ((name-lower (string-downcase name))
(versions-url (string-append %nuget-v3-package-versions-url name-lower "/index.json"))) (versions-url (string-append %nuget-v3-package-versions-url name-lower "/index.json")))
(let-values (((response body) (http-get versions-url))) (let ((versions-json (json-fetch versions-url)))
(if body (if versions-json
(let* ((versions-json (json->scm (open-bytevector-input-port body))) (let* ((available-versions (vector->list (or (assoc-ref versions-json "versions")
(available-versions (vector->list (or (assoc-ref versions-json "versions")
#()))) #())))
(semver-range (nuget->semver-range range-str))) (semver-range (nuget->semver-range range-str)))
;; Create a single, clean list of all valid semver objects first. ;; Create a single, clean list of all valid semver objects first.
@ -194,13 +194,12 @@ primitives suitable for the 'semver-range' constructor."
correctly handling the paginated structure of the registration index." correctly handling the paginated structure of the registration index."
(let* ((name-lower (string-downcase name)) (let* ((name-lower (string-downcase name))
(index-url (string-append %nuget-v3-registration-url name-lower "/index.json")) (index-url (string-append %nuget-v3-registration-url name-lower "/index.json"))
(index-response index-body (http-get index-url))) (index-json (json-fetch index-url)))
(if index-body (if index-json
(let* ((index-json (json->scm (open-bytevector-input-port index-body))) (let loop ((pages-to-check
;; Get the list of page objects. ;; Get the list of page objects.
(pages (vector->list (or (assoc-ref index-json "items") (vector->list (or (assoc-ref index-json "items")
#())))) #()))))
(let loop ((pages-to-check pages))
(if (null? pages-to-check) (if (null? pages-to-check)
;; If we've checked all pages and found nothing, fail. ;; If we've checked all pages and found nothing, fail.
(begin (begin
@ -212,12 +211,10 @@ primitives suitable for the 'semver-range' constructor."
(page-items (page-items
(or (and=> (assoc-ref current-page "items") (or (and=> (assoc-ref current-page "items")
vector->list) vector->list)
(let-values (((page-response page-body) (let ((page-json (json-fetch (assoc-ref current-page "@id"))))
(http-get (assoc-ref current-page "@id")))) (if page-json
(if page-body
(let ((page-json (json->scm (open-bytevector-input-port page-body))))
(vector->list (or (assoc-ref page-json "items") (vector->list (or (assoc-ref page-json "items")
#()))) #()))
'()))))) '())))))
;; Search for our specific version within THIS page's items. ;; Search for our specific version within THIS page's items.
(let ((entry-in-page (let ((entry-in-page
@ -231,7 +228,7 @@ primitives suitable for the 'semver-range' constructor."
;; Found it! Return the catalogEntry object. ;; Found it! Return the catalogEntry object.
(assoc-ref entry-in-page "catalogEntry") (assoc-ref entry-in-page "catalogEntry")
;; Not in this page, recurse to the next page. ;; Not in this page, recurse to the next page.
(loop (cdr pages-to-check)))))))) (loop (cdr pages-to-check)))))))
(begin (begin
(warning (G_ "Failed to fetch registration index for ~a~%") name) (warning (G_ "Failed to fetch registration index for ~a~%") name)
#f)))) #f))))