mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-10 16:50: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

89
guix/import/nuget.scm
View file

@ -29,7 +29,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#: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 (srfi srfi-1)
#:use-module (srfi srfi-11)
@ -51,6 +51,7 @@
#:use-module (guix utils)
#:use-module ((guix import utils)
#:select (factorize-uri snake-case recursive-import flatten))
#:use-module (guix import json)
#:use-module (guix base32)
#:use-module (guix build utils)
#:use-module (guix git)
@ -149,10 +150,9 @@ primitives suitable for the 'semver-range' constructor."
creation and filtering to avoid type errors."
(let* ((name-lower (string-downcase name))
(versions-url (string-append %nuget-v3-package-versions-url name-lower "/index.json")))
(let-values (((response body) (http-get versions-url)))
(if body
(let* ((versions-json (json->scm (open-bytevector-input-port body)))
(available-versions (vector->list (or (assoc-ref versions-json "versions")
(let ((versions-json (json-fetch versions-url)))
(if versions-json
(let* ((available-versions (vector->list (or (assoc-ref versions-json "versions")
#())))
(semver-range (nuget->semver-range range-str)))
;; Create a single, clean list of all valid semver objects first.
@ -194,47 +194,44 @@ primitives suitable for the 'semver-range' constructor."
correctly handling the paginated structure of the registration index."
(let* ((name-lower (string-downcase name))
(index-url (string-append %nuget-v3-registration-url name-lower "/index.json"))
(index-response index-body (http-get index-url)))
(if index-body
(let* ((index-json (json->scm (open-bytevector-input-port index-body)))
;; Get the list of page objects.
(pages (vector->list (or (assoc-ref index-json "items")
#()))))
(let loop ((pages-to-check pages))
(if (null? pages-to-check)
;; If we've checked all pages and found nothing, fail.
(begin
(warning (G_ "Could not find catalog entry for ~a version ~a in any page.~%") name version)
#f)
(let* ((current-page (car pages-to-check))
;; Get the items for the current page. This may require another
;; network request if the items are not inlined.
(page-items
(or (and=> (assoc-ref current-page "items")
vector->list)
(let-values (((page-response page-body)
(http-get (assoc-ref current-page "@id"))))
(if page-body
(let ((page-json (json->scm (open-bytevector-input-port page-body))))
(vector->list (or (assoc-ref page-json "items")
#())))
'())))))
;; Search for our specific version within THIS page's items.
(let ((entry-in-page
(find (lambda (item)
(and=>
(and=> (assoc-ref item "catalogEntry")
(cut assoc-ref <> "version"))
(lambda (v) (string=? v version)))) ; fixme semver equal
page-items)))
(if entry-in-page
;; Found it! Return the catalogEntry object.
(assoc-ref entry-in-page "catalogEntry")
;; Not in this page, recurse to the next page.
(loop (cdr pages-to-check))))))))
(begin
(warning (G_ "Failed to fetch registration index for ~a~%") name)
#f))))
(index-json (json-fetch index-url)))
(if index-json
(let loop ((pages-to-check
;; Get the list of page objects.
(vector->list (or (assoc-ref index-json "items")
#()))))
(if (null? pages-to-check)
;; If we've checked all pages and found nothing, fail.
(begin
(warning (G_ "Could not find catalog entry for ~a version ~a in any page.~%") name version)
#f)
(let* ((current-page (car pages-to-check))
;; Get the items for the current page. This may require another
;; network request if the items are not inlined.
(page-items
(or (and=> (assoc-ref current-page "items")
vector->list)
(let ((page-json (json-fetch (assoc-ref current-page "@id"))))
(if page-json
(vector->list (or (assoc-ref page-json "items")
#()))
'())))))
;; Search for our specific version within THIS page's items.
(let ((entry-in-page
(find (lambda (item)
(and=>
(and=> (assoc-ref item "catalogEntry")
(cut assoc-ref <> "version"))
(lambda (v) (string=? v version)))) ; fixme semver equal
page-items)))
(if entry-in-page
;; Found it! Return the catalogEntry object.
(assoc-ref entry-in-page "catalogEntry")
;; Not in this page, recurse to the next page.
(loop (cdr pages-to-check)))))))
(begin
(warning (G_ "Failed to fetch registration index for ~a~%") name)
#f))))
(define (car-safe lst)
(if (null? lst)