summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHilton Chain <hako@ultrarare.space>2025-06-09 18:35:27 +0800
committerHilton Chain <hako@ultrarare.space>2025-08-21 19:09:04 +0800
commit92d130e03594bd2b8e6688c83fc35a3f2c2954da (patch)
treec2dcc0d09edd789a9b4308c34a82eb0ab3e61642
parentefaa3e681ef14ac5e0900319557a21fb421b2053 (diff)
import: crate: Stop importing dependencies from crates.io.
* guix/scripts/import/crate.scm (show-help, %options, guix-import-crate) [--recursive, --recursive-dev-dependencies, --mark-missing]: Remove options. * doc/guix.texi (Invoking guix import)[crate]: Adjust accordingly. Mention packaging workflow. * guix/import/crate.scm (make-crate-sexp): Don't use "rust-" prefix and semver suffix for package name. [#:cargo-inputs, #:cargo-development-inputs, #:build?]: Remove arguments. (crate->guix-package)[#:include-dev-deps?, #:mark-missing?]: Remove arguments. (<crate-dependency>): Remove data type. (make-crate-dependency, crate-dependency?, json->crate-dependency) (crate-version-dependencies, package-names->package-inputs) (maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments) (version->semver-prefix, find-package-version, crate-recursive-import): Remove procedures. * tests/crate.scm (test-foo-crate, test-bar-crate): Adjust for modified tests. (test-foo-dependencies, test-bar-dependencies, test-root-crate) (test-root-dependencies, test-intermediate-a-crate) (test-intermediate-a-dependencies, test-intermediate-b-crate) (test-intermediate-b-dependencies, test-intermediate-c-crate) (test-intermediate-c-dependencies, test-leaf-alice-crate) (test-leaf-alice-dependencies, test-leaf-bob-crate) (test-leaf-bob-dependencies, rust-leaf-bob-3, rust-leaf-bob-3.0.2-yanked): Remove variables. ("crate->guix-package yanked", "crate->guix-package only yanked available"): New tests. ("crate->guix-package"): Adjust accordingly. ("crate->guix-package-marks-missing-packages", "crate-recursive-import") ("crate-recursive-import-honors-existing-packages") ("crate-import-only-yanked-available"): Remove tests. Change-Id: Ib1d24511ed0ea1a2373f53de12e06afa7950a7d7
-rw-r--r--doc/guix.texi16
-rw-r--r--guix/import/crate.scm267
-rw-r--r--guix/scripts/import/crate.scm85
-rw-r--r--tests/crate.scm1116
4 files changed, 152 insertions, 1332 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index bde3724dcd7..9147cd61ca6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14939,27 +14939,17 @@ guix import crate constant-time-eq@@0.1.0
14939Additional options include: 14939Additional options include:
14940 14940
14941@table @code 14941@table @code
14942@item --recursive
14943@itemx -r
14944Traverse the dependency graph of the given upstream package recursively
14945and generate package expressions for all those packages that are not yet
14946in Guix.
14947@item --recursive-dev-dependencies
14948If @option{--recursive-dev-dependencies} is specified, also the recursively
14949imported packages contain their development dependencies, which are recursively
14950imported as well.
14951@item --allow-yanked 14942@item --allow-yanked
14952If no non-yanked version of a crate is available, use the latest yanked 14943If no non-yanked version of a crate is available, use the latest yanked
14953version instead instead of aborting. 14944version instead instead of aborting.
14954@item --mark-missing
14955If a crate dependency is not (yet) packaged, make the corresponding
14956input in @code{#:cargo-inputs} or @code{#:cargo-development-inputs} into
14957a comment.
14958@item --lockfile=@var{file} 14945@item --lockfile=@var{file}
14959@itemx -f @var{file} 14946@itemx -f @var{file}
14960When @option{--lockfile} is specified, the importer will ignore other options 14947When @option{--lockfile} is specified, the importer will ignore other options
14961and won't output package expressions, instead importing source expressions 14948and won't output package expressions, instead importing source expressions
14962from @var{file}, a @file{Cargo.lock} file. 14949from @var{file}, a @file{Cargo.lock} file.
14950
14951@xref{Packaging Rust Crates,,, guix-cookbook, GNU Guix Cookbook}, for packaging
14952workflow utilizing it.
14963@end table 14953@end table
14964 14954
14965@item elm 14955@item elm
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index b7a3250c138..3973be1e13f 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -104,20 +104,9 @@
104 (yanked? crate-version-yanked? "yanked") ;boolean 104 (yanked? crate-version-yanked? "yanked") ;boolean
105 (links crate-version-links)) ;alist 105 (links crate-version-links)) ;alist
106 106
107;; Crate dependency. Each dependency (each edge in the graph) is annotated as
108;; being a "normal" dependency or a development dependency. There also
109;; information about the minimum required version, such as "^0.0.41".
110(define-json-mapping <crate-dependency> make-crate-dependency
111 crate-dependency?
112 json->crate-dependency
113 (id crate-dependency-id "crate_id") ;string
114 (kind crate-dependency-kind "kind" ;'normal | 'dev | 'build
115 string->symbol)
116 (requirement crate-dependency-requirement "req")) ;string
117
118;; Autoload Guile-Semver so we only have a soft dependency. 107;; Autoload Guile-Semver so we only have a soft dependency.
119(module-autoload! (current-module) 108(module-autoload! (current-module)
120 '(semver) '(string->semver semver->string semver<? semver=? semver>?)) 109 '(semver) '(string->semver semver->string semver>?))
121(module-autoload! (current-module) 110(module-autoload! (current-module)
122 '(semver ranges) '(string->semver-range semver-range-contains?)) 111 '(semver ranges) '(string->semver-range semver-range-contains?))
123 112
@@ -138,91 +127,17 @@ record or #f if it was not found."
138 127
139(define lookup-crate* (memoize lookup-crate)) 128(define lookup-crate* (memoize lookup-crate))
140 129
141(define (crate-version-dependencies version)
142 "Return the list of <crate-dependency> records of VERSION, a
143<crate-version>."
144 (let* ((path (assoc-ref (crate-version-links version) "dependencies"))
145 (url (string-append (%crate-base-url) path)))
146 (match (assoc-ref (or (json-fetch url) '()) "dependencies")
147 ((? vector? vector)
148 (delete-duplicates (map json->crate-dependency (vector->list vector))))
149 (_
150 '()))))
151
152 130
153;;; 131;;;
154;;; Converting crates to Guix packages. 132;;; Converting crates to Guix packages.
155;;; 133;;;
156 134
157(define* (package-names->package-inputs names #:optional (output #f)) 135(define* (make-crate-sexp #:key name version
158 "Given a list of PACKAGE-NAMES or (PACKAGE-NAME VERSION) pairs, and an 136 home-page synopsis description license yanked?)
159optional OUTPUT, tries to generate a quoted list of inputs, as suitable to
160use in an 'inputs' field of a package definition."
161 (define (make-input input version)
162 (cons* input (list 'unquote (string->symbol
163 (if version
164 (string-append input "-" version)
165 input)))
166 (or (and output (list output))
167 '())))
168
169 (map (match-lambda
170 ((input version) (make-input input version))
171 ((? blank? comment) comment)
172 (input (make-input input #f)))
173 names))
174
175(define (maybe-cargo-inputs package-names)
176 (match (package-names->package-inputs package-names)
177 (()
178 '())
179 ((package-inputs ...)
180 `(#:cargo-inputs ,package-inputs))))
181
182(define (maybe-cargo-development-inputs package-names)
183 (match (package-names->package-inputs package-names)
184 (()
185 '())
186 ((package-inputs ...)
187 `(#:cargo-development-inputs ,package-inputs))))
188
189(define (maybe-arguments arguments)
190 (match arguments
191 (()
192 '())
193 ((args ...)
194 `((arguments (,'quasiquote ,args))))))
195
196(define (version->semver-prefix version)
197 "Return the version up to and including the first non-zero part"
198 (first
199 (map match:substring
200 (list-matches "^(0+\\.){,2}[0-9]+" version))))
201
202(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
203 home-page synopsis description license build? yanked?)
204 "Return the `package' s-expression for a rust package with the given NAME, 137 "Return the `package' s-expression for a rust package with the given NAME,
205VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, 138VERSION, HOME-PAGE, SYNOPSIS, DESCRIPTION and LICENSE."
206and LICENSE."
207 (define (format-inputs inputs)
208 (map
209 (match-lambda
210 ((name missing version yanked)
211 (let ((input (list (crate-name->package-name name)
212 (if yanked
213 (string-append version "-yanked")
214 (version->semver-prefix version)))))
215 (if missing
216 (comment
217 (string-append ";; " (string-join input "-") "\n")
218 #f)
219 input))))
220 inputs))
221
222 (let* ((port (http-fetch (crate-uri name version))) 139 (let* ((port (http-fetch (crate-uri name version)))
223 (guix-name (crate-name->package-name name)) 140 (guix-name (downstream-package-name "" name))
224 (cargo-inputs (format-inputs cargo-inputs))
225 (cargo-development-inputs (format-inputs cargo-development-inputs))
226 (description (beautify-description description)) 141 (description (beautify-description description))
227 (pkg `(package 142 (pkg `(package
228 (name ,guix-name) 143 (name ,guix-name)
@@ -234,9 +149,9 @@ and LICENSE."
234 (method url-fetch) 149 (method url-fetch)
235 (uri (crate-uri ,name version)) 150 (uri (crate-uri ,name version))
236 (file-name 151 (file-name
237 ,@(if yanked? 152 ,@(if yanked?
238 `((string-append name "-" version "-yanked.tar.gz")) 153 `((string-append name "-" version "-yanked.tar.gz"))
239 `((string-append name "-" version ".tar.gz")))) 154 `((string-append name "-" version ".tar.gz"))))
240 (sha256 155 (sha256
241 (base32 156 (base32
242 ,(bytevector->nix-base32-string (port-sha256 port)))))) 157 ,(bytevector->nix-base32-string (port-sha256 port))))))
@@ -244,12 +159,7 @@ and LICENSE."
244 `((properties '((crate-version-yanked? . #t)))) 159 `((properties '((crate-version-yanked? . #t))))
245 '()) 160 '())
246 (build-system cargo-build-system) 161 (build-system cargo-build-system)
247 ,@(maybe-arguments (append (if build? 162 (inputs (cargo-inputs ',(string->symbol guix-name)))
248 '()
249 '(#:skip-build? #t))
250 (maybe-cargo-inputs cargo-inputs)
251 (maybe-cargo-development-inputs
252 cargo-development-inputs)))
253 (home-page ,home-page) 163 (home-page ,home-page)
254 (synopsis ,(beautify-synopsis synopsis)) 164 (synopsis ,(beautify-synopsis synopsis))
255 (description ,(if (string-prefix? "This" description) 165 (description ,(if (string-prefix? "This" description)
@@ -262,10 +172,7 @@ and LICENSE."
262 ((license) license) 172 ((license) license)
263 (_ `(list ,@license))))))) 173 (_ `(list ,@license)))))))
264 (close-port port) 174 (close-port port)
265 (package->definition pkg 175 (package->definition pkg)))
266 (if yanked?
267 (string-append version "-yanked")
268 (version->semver-prefix version)))))
269 176
270(define (string->license string) 177(define (string->license string)
271 (filter-map (lambda (license) 178 (filter-map (lambda (license)
@@ -310,50 +217,13 @@ satisfies SEMVER-RANGE."
310 (not (crate-version-yanked? entry))) 217 (not (crate-version-yanked? entry)))
311 (crate-versions crate))) 218 (crate-versions crate)))
312 219
313(define (find-package-version name range allow-yanked?)
314 "Find the latest existing package that fulfills the SemVer RANGE. If
315ALLOW-YANKED? is #t, include packages marked as yanked at a lower
316priority."
317 (set! range (string->semver-range range))
318 (let loop ((packages (find-packages-by-name
319 (crate-name->package-name name)))
320 (semver #f)
321 (yanked? #f))
322 (match packages
323 ((pkg packages ...)
324 (let ((pkg-yanked? (assoc-ref (package-properties pkg)
325 'crate-version-yanked?)))
326 (if (or allow-yanked? (not pkg-yanked?))
327 (let ((pkg-semver (string->semver (package-version pkg))))
328 (if (and (or (not semver)
329 (and yanked? (not pkg-yanked?))
330 (and (eq? yanked? pkg-yanked?)
331 (semver>? pkg-semver semver)))
332 (semver-range-contains? range pkg-semver))
333 (loop packages pkg-semver pkg-yanked?)
334 (loop packages semver yanked?)))
335 (loop packages semver yanked?))))
336 (() (and semver (list (semver->string semver) yanked?))))))
337
338(define* (crate->guix-package 220(define* (crate->guix-package
339 crate-name 221 crate-name #:key version allow-yanked? #:allow-other-keys)
340 #:key version include-dev-deps? allow-yanked? mark-missing?
341 #:allow-other-keys)
342 "Fetch the metadata for CRATE-NAME from crates.io, and return the 222 "Fetch the metadata for CRATE-NAME from crates.io, and return the
343`package' s-expression corresponding to that package, or #f on failure. 223`package' s-expression corresponding to that package, or #f on failure.
344When VERSION is specified, convert it into a semver range and attempt to fetch 224When VERSION is specified, convert it into a semver range and attempt to fetch
345the latest version matching this semver range; otherwise fetch the latest 225the latest version matching this semver range; otherwise fetch the latest
346version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this will also 226version of CRATE-NAME."
347look up the development dependencs for the given crate."
348
349 (define (semver-range-contains-string? range version)
350 (semver-range-contains? (string->semver-range range)
351 (string->semver version)))
352
353 (define (normal-dependency? dependency)
354 (or (eq? (crate-dependency-kind dependency) 'build)
355 (eq? (crate-dependency-kind dependency) 'normal)))
356
357 (define crate 227 (define crate
358 (lookup-crate* crate-name)) 228 (lookup-crate* crate-name))
359 229
@@ -375,112 +245,29 @@ look up the development dependencs for the given crate."
375 (max-crate-version-of-semver semver-range 245 (max-crate-version-of-semver semver-range
376 (crate-versions crate)))))) 246 (crate-versions crate))))))
377 247
378 ;; If no non-yanked existing package version was found, check the upstream
379 ;; versions. If a non-yanked upstream version exists, use it instead,
380 ;; otherwise use the existing package version, provided it exists.
381 (define (dependency-name+missing+version+yanked dep)
382 (let* ((name (crate-dependency-id dep))
383 (req (crate-dependency-requirement dep))
384 (existing-version
385 (find-package-version name req allow-yanked?)))
386 (if (and existing-version (not (second existing-version)))
387 (cons* name #f existing-version)
388 (let* ((crate (lookup-crate* name))
389 (ver (find-crate-version crate req)))
390 (if existing-version
391 (if (and ver (not (crate-version-yanked? ver)))
392 (if (semver=? (string->semver (first existing-version))
393 (string->semver (crate-version-number ver)))
394 (begin
395 (warning (G_ "~A: version ~a is no longer yanked~%")
396 name (first existing-version))
397 (cons* name #f existing-version))
398 (list name
399 #f
400 (crate-version-number ver)
401 (crate-version-yanked? ver)))
402 (begin
403 (warning (G_ "~A: using existing version ~a, which was yanked~%")
404 name (first existing-version))
405 (cons* name #f existing-version)))
406 (begin
407 (unless ver
408 (leave (G_ "~A: no version found for requirement ~a~%") name req))
409 (if (crate-version-yanked? ver)
410 (warning (G_ "~A: imported version ~a was yanked~%")
411 name (crate-version-number ver)))
412 (list name
413 mark-missing?
414 (crate-version-number ver)
415 (crate-version-yanked? ver))))))))
416
417 (define version* 248 (define version*
418 (and crate 249 (and crate
419 (or (find-crate-version crate version-number) 250 (or (find-crate-version crate version-number)
420 (leave (G_ "~A: version ~a not found~%") crate-name version-number)))) 251 (leave (G_ "~A: version ~a not found~%") crate-name version-number))))
421 252
422 ;; sort and map the dependencies to a list containing
423 ;; pairs of (name version)
424 (define (sort-map-dependencies deps)
425 (sort (map dependency-name+missing+version+yanked
426 deps)
427 (match-lambda* (((name _ _ _) ...)
428 (apply string-ci<? name)))))
429
430 (define (remove-missing+yanked-info deps)
431 (map
432 (match-lambda ((name missing version yanked)
433 (list name version)))
434 deps))
435
436 (if (and crate version*) 253 (if (and crate version*)
437 (let* ((dependencies (crate-version-dependencies version*)) 254 (make-crate-sexp #:yanked? (crate-version-yanked? version*)
438 (dep-crates dev-dep-crates (partition normal-dependency? dependencies)) 255 #:name crate-name
439 (cargo-inputs (sort-map-dependencies dep-crates)) 256 #:version (crate-version-number version*)
440 (cargo-development-inputs (if include-dev-deps? 257 #:home-page
441 (sort-map-dependencies dev-dep-crates) 258 (let ((home-page (crate-home-page crate)))
442 '()))) 259 (if (string? home-page)
443 (values 260 home-page
444 (make-crate-sexp #:build? include-dev-deps? 261 (let ((repository (crate-repository crate)))
445 #:yanked? (crate-version-yanked? version*) 262 (if (string? repository)
446 #:name crate-name 263 repository
447 #:version (crate-version-number version*) 264 ""))))
448 #:cargo-inputs cargo-inputs 265 #:synopsis (crate-description crate)
449 #:cargo-development-inputs cargo-development-inputs 266 #:description (crate-description crate)
450 #:home-page 267 #:license (and=> (crate-version-license version*)
451 (let ((home-page (crate-home-page crate))) 268 string->license))
452 (if (string? home-page)
453 home-page
454 (let ((repository (crate-repository crate)))
455 (if (string? repository)
456 repository
457 ""))))
458 #:synopsis (crate-description crate)
459 #:description (crate-description crate)
460 #:license (and=> (crate-version-license version*)
461 string->license))
462 (append
463 (remove-missing+yanked-info cargo-inputs)
464 (remove-missing+yanked-info cargo-development-inputs))))
465 (values #f '()))) 269 (values #f '())))
466 270
467(define* (crate-recursive-import
468 crate-name #:key version recursive-dev-dependencies? allow-yanked?)
469 (recursive-import
470 crate-name
471 #:repo->guix-package
472 (let ((crate->guix-package* (memoize crate->guix-package)))
473 (lambda* params
474 ;; download development dependencies only for the top level package
475 (let ((include-dev-deps?
476 (or (equal? (car params) crate-name)
477 recursive-dev-dependencies?)))
478 (apply crate->guix-package*
479 (append params `(#:include-dev-deps? ,include-dev-deps?
480 #:allow-yanked? ,allow-yanked?))))))
481 #:version version
482 #:guix-name crate-name->package-name))
483
484(define (guix-package->crate-name package) 271(define (guix-package->crate-name package)
485 "Return the crate name of PACKAGE." 272 "Return the crate name of PACKAGE."
486 (and-let* ((origin (package-source package)) 273 (and-let* ((origin (package-source package))
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 8791d1092b2..0218cced742 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -50,17 +50,8 @@
50 (display (G_ "Usage: guix import crate PACKAGE-NAME 50 (display (G_ "Usage: guix import crate PACKAGE-NAME
51Import and convert the crates.io package for PACKAGE-NAME.\n")) 51Import and convert the crates.io package for PACKAGE-NAME.\n"))
52 (display (G_ " 52 (display (G_ "
53 -r, --recursive import packages recursively"))
54 (display (G_ "
55 --recursive-dev-dependencies
56 include dev-dependencies recursively"))
57 (newline)
58 (display (G_ "
59 --allow-yanked allow importing yanked crates if no alternative 53 --allow-yanked allow importing yanked crates if no alternative
60 satisfying the version requirement is found")) 54 satisfying the version requirement is found"))
61 (display (G_ "
62 --mark-missing comment out the desired dependency if no
63 sufficient package exists for it"))
64 (newline) 55 (newline)
65 (display (G_ " 56 (display (G_ "
66 -f, --lockfile=FILE import dependencies from FILE, a 'Cargo.lock' file")) 57 -f, --lockfile=FILE import dependencies from FILE, a 'Cargo.lock' file"))
@@ -81,18 +72,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
81 (option '(#\V "version") #f #f 72 (option '(#\V "version") #f #f
82 (lambda args 73 (lambda args
83 (show-version-and-exit "guix import crate"))) 74 (show-version-and-exit "guix import crate")))
84 (option '(#\r "recursive") #f #f
85 (lambda (opt name arg result)
86 (alist-cons 'recursive #t result)))
87 (option '("recursive-dev-dependencies") #f #f
88 (lambda (opt name arg result)
89 (alist-cons 'recursive-dev-dependencies #t result)))
90 (option '("allow-yanked") #f #f 75 (option '("allow-yanked") #f #f
91 (lambda (opt name arg result) 76 (lambda (opt name arg result)
92 (alist-cons 'allow-yanked #t result))) 77 (alist-cons 'allow-yanked #t result)))
93 (option '("mark-missing") #f #f
94 (lambda (opt name arg result)
95 (alist-cons 'mark-missing #t result)))
96 (option '(#\f "lockfile") #f #t 78 (option '(#\f "lockfile") #f #t
97 (lambda (opt name arg result) 79 (lambda (opt name arg result)
98 (if (file-exists? arg) 80 (if (file-exists? arg)
@@ -124,44 +106,35 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
124 (define-values (name version) 106 (define-values (name version)
125 (package-name->name+version spec)) 107 (package-name->name+version spec))
126 108
127 (match (cond 109 (match (if lockfile
128 (lockfile 110 (let ((source-expressions
129 (let ((source-expressions 111 _
130 _ 112 (cargo-lock->expressions lockfile name)))
131 (cargo-lock->expressions lockfile name))) 113 (when file-to-insert
132 (when file-to-insert 114 (let* ((source-expressions
133 (let* ((source-expressions 115 cargo-inputs-entry
134 cargo-inputs-entry 116 (cargo-lock->expressions lockfile name))
135 (cargo-lock->expressions lockfile name)) 117 (term (first cargo-inputs-entry))
136 (term (first cargo-inputs-entry)) 118 (cargo-inputs
137 (cargo-inputs 119 `(define-cargo-inputs lookup-cargo-inputs
138 `(define-cargo-inputs lookup-cargo-inputs 120 ,@(sort
139 ,@(sort 121 (cons cargo-inputs-entry
140 (cons cargo-inputs-entry 122 (extract-cargo-inputs
141 (extract-cargo-inputs 123 file-to-insert #:exclude term))
142 file-to-insert #:exclude term)) 124 (lambda (a b)
143 (lambda (a b) 125 (string< (symbol->string (first a))
144 (string< (symbol->string (first a)) 126 (symbol->string (first b)))))))
145 (symbol->string (first b))))))) 127 (_
146 (_ 128 (and=> (find-cargo-inputs-location file-to-insert)
147 (and=> (find-cargo-inputs-location file-to-insert) 129 delete-expression))
148 delete-expression)) 130 (port (open-file file-to-insert "a")))
149 (port (open-file file-to-insert "a"))) 131 (pretty-print-with-comments port cargo-inputs)
150 (pretty-print-with-comments port cargo-inputs) 132 (newline port)
151 (newline port) 133 (close-port port)))
152 (close-port port))) 134 source-expressions)
153 source-expressions)) 135 (crate->guix-package
154 ((assoc-ref opts 'recursive) 136 name #:version version
155 (crate-recursive-import 137 #:allow-yanked? (assoc-ref opts 'allow-yanked)))
156 name #:version version
157 #:recursive-dev-dependencies?
158 (assoc-ref opts 'recursive-dev-dependencies)
159 #:allow-yanked? (assoc-ref opts 'allow-yanked)))
160 (else
161 (crate->guix-package
162 name #:version version #:include-dev-deps? #t
163 #:allow-yanked? (assoc-ref opts 'allow-yanked)
164 #:mark-missing? (assoc-ref opts 'mark-missing))))
165 ((or #f '()) 138 ((or #f '())
166 (leave (G_ "failed to download meta-data for package '~a'~%") 139 (leave (G_ "failed to download meta-data for package '~a'~%")
167 (if version 140 (if version
diff --git a/tests/crate.scm b/tests/crate.scm
index 8c1f6e738db..b5599e5d482 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -37,51 +37,10 @@
37 #:use-module (srfi srfi-11) 37 #:use-module (srfi srfi-11)
38 #:use-module (srfi srfi-64)) 38 #:use-module (srfi srfi-64))
39 39
40
41;; crate versions and dependencies used here
42;; foo-0.8.1
43;; foo-1.0.0
44;; foo-1.0.3
45;; leaf-alice 0.7.5
46;; bar-1.0.0
47;; leaf-bob 3.0.1
48;; leaf-bob 3.0.2 (dev-dependency)
49;; leaf-bob 4.0.0 (dev-dependency)
50;;
51;; root-1.0.0
52;; root-1.0.4
53;; intermediate-a 1.0.42
54;; intermediate-b ^1.0.0
55;; leaf-alice ^0.7
56;; leaf-bob ^3
57;; leaf-bob 3 (build-dependency)
58;; intermediate-c 1 (dev-dependency)
59;;
60;; intermediate-a-1.0.40
61;; intermediate-a-1.0.42
62;; intermediate-a-1.1.0-alpha.1
63;; intermediate-a 1.2.3
64;; leaf-alice 0.7.5
65;; leaf-bob ^3
66;;
67;; intermediate-b-1.2.3
68;; leaf-bob 3.0.1
69;;
70;; intermediate-c-1.0.1
71;; leaf-alice 0.7.5 (dev-dependency)
72;;
73;; leaf-alice-0.7.3
74;; leaf-alice-0.7.5
75;;
76;; leaf-bob-3.0.1
77;; leaf-bob-3.0.2 (yanked)
78;; leaf-bob-4.0.0 (yanked)
79
80
81(define test-foo-crate 40(define test-foo-crate
82 "{ 41 "{
83 \"crate\": { 42 \"crate\": {
84 \"max_version\": \"1.0.3\", 43 \"max_version\": \"1.0.0\",
85 \"name\": \"foo\", 44 \"name\": \"foo\",
86 \"description\": \"summary\", 45 \"description\": \"summary\",
87 \"homepage\": \"http://example.com\", 46 \"homepage\": \"http://example.com\",
@@ -111,23 +70,12 @@
111 \"links\": { 70 \"links\": {
112 \"dependencies\": \"/api/v1/crates/foo/1.0.3/dependencies\" 71 \"dependencies\": \"/api/v1/crates/foo/1.0.3/dependencies\"
113 }, 72 },
114 \"yanked\": false 73 \"yanked\": true
115 } 74 }
116 ] 75 ]
117 } 76 }
118}") 77}")
119 78
120(define test-foo-dependencies
121 "{
122 \"dependencies\": [
123 {
124 \"crate_id\": \"leaf-alice\",
125 \"kind\": \"normal\",
126 \"req\": \"0.7.5\"
127 }
128 ]
129}")
130
131(define test-bar-crate 79(define test-bar-crate
132 "{ 80 "{
133 \"crate\": { 81 \"crate\": {
@@ -145,338 +93,18 @@
145 \"links\": { 93 \"links\": {
146 \"dependencies\": \"/api/v1/crates/bar/1.0.0/dependencies\" 94 \"dependencies\": \"/api/v1/crates/bar/1.0.0/dependencies\"
147 }, 95 },
148 \"yanked\": false
149 }
150 ]
151 }
152}")
153
154(define test-bar-dependencies
155 "{
156 \"dependencies\": [
157 {
158 \"crate_id\": \"leaf-bob\",
159 \"kind\": \"normal\",
160 \"req\": \"3.0.1\"
161 },
162 {
163 \"crate_id\": \"leaf-bob\",
164 \"kind\": \"dev\",
165 \"req\": \"^3.0.2\"
166 },
167 {
168 \"crate_id\": \"leaf-bob\",
169 \"kind\": \"dev\",
170 \"req\": \"^4.0.0\"
171 }
172 ]
173}")
174
175(define test-root-crate
176 "{
177 \"crate\": {
178 \"max_version\": \"1.0.4\",
179 \"name\": \"root\",
180 \"description\": \"summary\",
181 \"homepage\": \"http://example.com\",
182 \"repository\": \"http://example.com\",
183 \"keywords\": [\"dummy\", \"test\"],
184 \"categories\": [\"test\"],
185 \"actual_versions\": [
186 { \"id\": 234240,
187 \"num\": \"1.0.0\",
188 \"license\": \"MIT OR Apache-2.0\",
189 \"links\": {
190 \"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\"
191 },
192 \"yanked\": false
193 },
194 { \"id\": 234242,
195 \"num\": \"1.0.4\",
196 \"license\": \"MIT OR Apache-2.0\",
197 \"links\": {
198 \"dependencies\": \"/api/v1/crates/root/1.0.4/dependencies\"
199 },
200 \"yanked\": false
201 }
202 ]
203 }
204}")
205
206(define test-root-dependencies
207 "{
208 \"dependencies\": [
209 {
210 \"crate_id\": \"intermediate-a\",
211 \"kind\": \"normal\",
212 \"req\": \"1.0.42\"
213 },
214 {
215 \"crate_id\": \"intermediate-b\",
216 \"kind\": \"normal\",
217 \"req\": \"^1.0.0\"
218 },
219 {
220 \"crate_id\": \"leaf-alice\",
221 \"kind\": \"normal\",
222 \"req\": \"^0.7\"
223 },
224 {
225 \"crate_id\": \"leaf-bob\",
226 \"kind\": \"normal\",
227 \"req\": \"^3\"
228 },
229 {
230 \"crate_id\": \"leaf-bob\",
231 \"kind\": \"build\",
232 \"req\": \"3\"
233 },
234 {
235 \"crate_id\": \"intermediate-c\",
236 \"kind\": \"dev\",
237 \"req\": \"1\"
238 }
239 ]
240}")
241
242(define test-intermediate-a-crate
243 "{
244 \"crate\": {
245 \"max_version\": \"1.1.0-alpha.1\",
246 \"name\": \"intermediate-a\",
247 \"description\": \"summary\",
248 \"homepage\": \"http://example.com\",
249 \"repository\": \"http://example.com\",
250 \"keywords\": [\"dummy\", \"test\"],
251 \"categories\": [\"test\"],
252 \"actual_versions\": [
253 { \"id\": 234251,
254 \"num\": \"1.0.40\",
255 \"license\": \"MIT OR Apache-2.0\",
256 \"links\": {
257 \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.40/dependencies\"
258 },
259 \"yanked\": false
260 },
261 { \"id\": 234250,
262 \"num\": \"1.0.42\",
263 \"license\": \"MIT OR Apache-2.0\",
264 \"links\": {
265 \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.42/dependencies\"
266 },
267 \"yanked\": false
268 },
269 { \"id\": 234252,
270 \"num\": \"1.1.0-alpha.1\",
271 \"license\": \"MIT OR Apache-2.0\",
272 \"links\": {
273 \"dependencies\": \"/api/v1/crates/intermediate-a/1.1.0-alpha.1/dependencies\"
274 },
275 \"yanked\": false
276 }
277 ]
278 }
279}")
280
281(define test-intermediate-a-dependencies
282 "{
283 \"dependencies\": [
284 {
285 \"crate_id\": \"intermediate-b\",
286 \"kind\": \"normal\",
287 \"req\": \"1.2.3\"
288 },
289 {
290 \"crate_id\": \"leaf-alice\",
291 \"kind\": \"normal\",
292 \"req\": \"0.7.5\"
293 },
294 {
295 \"crate_id\": \"leaf-bob\",
296 \"kind\": \"normal\",
297 \"req\": \"^3\"
298 }
299 ]
300}")
301
302(define test-intermediate-b-crate
303 "{
304 \"crate\": {
305 \"max_version\": \"1.2.3\",
306 \"name\": \"intermediate-b\",
307 \"description\": \"summary\",
308 \"homepage\": \"http://example.com\",
309 \"repository\": \"http://example.com\",
310 \"keywords\": [\"dummy\", \"test\"],
311 \"categories\": [\"test\"],
312 \"actual_versions\": [
313 { \"id\": 234260,
314 \"num\": \"1.2.3\",
315 \"license\": \"MIT OR Apache-2.0\",
316 \"links\": {
317 \"dependencies\": \"/api/v1/crates/intermediate-b/1.2.3/dependencies\"
318 },
319 \"yanked\": false
320 }
321 ]
322 }
323}")
324
325(define test-intermediate-b-dependencies
326 "{
327 \"dependencies\": [
328 {
329 \"crate_id\": \"leaf-bob\",
330 \"kind\": \"normal\",
331 \"req\": \"3.0.1\"
332 }
333 ]
334}")
335
336(define test-intermediate-c-crate
337 "{
338 \"crate\": {
339 \"max_version\": \"1.0.1\",
340 \"name\": \"intermediate-c\",
341 \"description\": \"summary\",
342 \"homepage\": \"http://example.com\",
343 \"repository\": \"http://example.com\",
344 \"keywords\": [\"dummy\", \"test\"],
345 \"categories\": [\"test\"],
346 \"actual_versions\": [
347 { \"id\": 234290,
348 \"num\": \"1.0.1\",
349 \"license\": \"MIT OR Apache-2.0\",
350 \"links\": {
351 \"dependencies\": \"/api/v1/crates/intermediate-c/1.0.1/dependencies\"
352 },
353 \"yanked\": false
354 }
355 ]
356 }
357}")
358
359(define test-intermediate-c-dependencies
360 "{
361 \"dependencies\": [
362 {
363 \"crate_id\": \"leaf-alice\",
364 \"kind\": \"dev\",
365 \"req\": \"0.7.5\"
366 }
367 ]
368}")
369
370(define test-leaf-alice-crate
371 "{
372 \"crate\": {
373 \"max_version\": \"0.7.5\",
374 \"name\": \"leaf-alice\",
375 \"description\": \"summary\",
376 \"homepage\": \"http://example.com\",
377 \"repository\": \"http://example.com\",
378 \"keywords\": [\"dummy\", \"test\"],
379 \"categories\": [\"test\"],
380 \"actual_versions\": [
381 { \"id\": 234270,
382 \"num\": \"0.7.3\",
383 \"license\": \"MIT OR Apache-2.0\",
384 \"links\": {
385 \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.3/dependencies\"
386 },
387 \"yanked\": false
388 },
389 { \"id\": 234272,
390 \"num\": \"0.7.5\",
391 \"license\": \"MIT OR Apache-2.0\",
392 \"links\": {
393 \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.5/dependencies\"
394 },
395 \"yanked\": false
396 }
397 ]
398 }
399}")
400
401(define test-leaf-alice-dependencies
402 "{
403 \"dependencies\": []
404}")
405
406(define test-leaf-bob-crate
407 "{
408 \"crate\": {
409 \"max_version\": \"3.0.1\",
410 \"name\": \"leaf-bob\",
411 \"description\": \"summary\",
412 \"homepage\": \"http://example.com\",
413 \"repository\": \"http://example.com\",
414 \"keywords\": [\"dummy\", \"test\"],
415 \"categories\": [\"test\"]
416 \"actual_versions\": [
417 { \"id\": 234280,
418 \"num\": \"3.0.1\",
419 \"license\": \"MIT OR Apache-2.0\",
420 \"links\": {
421 \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\"
422 },
423 \"yanked\": false
424 },
425 { \"id\": 234281,
426 \"num\": \"3.0.2\",
427 \"license\": \"MIT OR Apache-2.0\",
428 \"links\": {
429 \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.2/dependencies\"
430 },
431 \"yanked\": true
432 },
433 { \"id\": 234282,
434 \"num\": \"4.0.0\",
435 \"license\": \"MIT OR Apache-2.0\",
436 \"links\": {
437 \"dependencies\": \"/api/v1/crates/leaf-bob/4.0.0/dependencies\"
438 },
439 \"yanked\": true 96 \"yanked\": true
440 } 97 }
441 ] 98 ]
442 } 99 }
443}") 100}")
444 101
445(define test-leaf-bob-dependencies
446 "{
447 \"dependencies\": []
448}")
449
450
451(define test-source-hash 102(define test-source-hash
452 "") 103 "")
453 104
454(define have-guile-semver? 105(define have-guile-semver?
455 (false-if-exception (resolve-interface '(semver)))) 106 (false-if-exception (resolve-interface '(semver))))
456 107
457(define rust-leaf-bob-3
458 (package
459 (name "rust-leaf-bob")
460 (version "3.0.1")
461 (source #f)
462 (build-system #f)
463 (home-page #f)
464 (synopsis #f)
465 (description #f)
466 (license #f)))
467
468(define rust-leaf-bob-3.0.2-yanked
469 (package
470 (name "rust-leaf-bob")
471 (version "3.0.2")
472 (source #f)
473 (properties '((crate-version-yanked? . #t)))
474 (build-system #f)
475 (home-page #f)
476 (synopsis #f)
477 (description #f)
478 (license #f)))
479
480(define temp-file 108(define temp-file
481 (string-append "t-crate-" (number->string (getpid)))) 109 (string-append "t-crate-" (number->string (getpid))))
482 110
@@ -491,7 +119,7 @@
491 (source (dummy-origin 119 (source (dummy-origin
492 (uri (crate-uri "rustc-serialize" "1.0"))))))) 120 (uri (crate-uri "rustc-serialize" "1.0")))))))
493 121
494(unless have-guile-semver? (test-skip 1)) 122(unless have-guile-semver? (test-skip 3))
495(test-assert "crate->guix-package" 123(test-assert "crate->guix-package"
496 ;; Replace network resources with sample data. 124 ;; Replace network resources with sample data.
497 (mock ((guix http-client) http-fetch 125 (mock ((guix http-client) http-fetch
@@ -499,463 +127,110 @@
499 (match url 127 (match url
500 ("https://crates.io/api/v1/crates/foo" 128 ("https://crates.io/api/v1/crates/foo"
501 (open-input-string test-foo-crate)) 129 (open-input-string test-foo-crate))
502 ("https://crates.io/api/v1/crates/foo/1.0.3/download" 130 ("https://crates.io/api/v1/crates/foo/1.0.0/download"
503 (set! test-source-hash
504 (bytevector->nix-base32-string
505 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
506 (open-input-string "empty file\n"))
507 ("https://crates.io/api/v1/crates/foo/1.0.3/dependencies"
508 (open-input-string test-foo-dependencies))
509 ("https://crates.io/api/v1/crates/leaf-alice"
510 (open-input-string test-leaf-alice-crate))
511 ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
512 (set! test-source-hash 131 (set! test-source-hash
513 (bytevector->nix-base32-string 132 (bytevector->nix-base32-string
514 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 133 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
515 (open-input-string "empty file\n")) 134 (open-input-string "empty file\n"))
516 ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies"
517 (open-input-string test-leaf-alice-dependencies))
518 (_ (error "Unexpected URL: " url))))) 135 (_ (error "Unexpected URL: " url)))))
519 136
520 (match (crate->guix-package "foo") 137 (match (crate->guix-package "foo")
521 ((define-public 'rust-foo-1 138 (`(define-public foo
522 (package (name "rust-foo") 139 (package (name "foo")
523 (version "1.0.3") 140 (version "1.0.0")
524 (source 141 (source
525 (origin 142 (origin
526 (method url-fetch) 143 (method url-fetch)
527 (uri (crate-uri "foo" 'version)) 144 (uri (crate-uri "foo" version))
528 (file-name (string-append name "-" version ".tar.gz")) 145 (file-name (string-append name "-" version ".tar.gz"))
529 (sha256 146 (sha256
530 (base32 147 (base32
531 (? string? hash))))) 148 ,(? string? hash)))))
532 (build-system 'cargo-build-system) 149 (build-system cargo-build-system)
533 (arguments 150 (inputs (cargo-inputs 'foo))
534 ('quasiquote 151 (home-page "http://example.com")
535 (#:skip-build? #t 152 (synopsis "summary")
536 #:cargo-inputs 153 (description "This package provides summary.")
537 (("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7)))))) 154 (license (list license:expat license:asl2.0))))
538 (home-page "http://example.com")
539 (synopsis "summary")
540 (description "This package provides summary.")
541 (license (list license:expat license:asl2.0))))
542 155
543 (string=? test-source-hash hash)) 156 (string=? test-source-hash hash))
544 (x 157 (x
545 (pk 'fail x #f))))) 158 (pk 'fail x #f)))))
546 159
547(unless have-guile-semver? (test-skip 1)) 160(test-assert "crate->guix-package yanked"
548(test-assert "crate->guix-package-marks-missing-packages"
549 (mock 161 (mock
550 ((gnu packages) find-packages-by-name 162 ((guix http-client) http-fetch
551 (lambda* (name #:optional version) 163 (lambda (url . rest)
552 (match name 164 (match url
553 ("rust-leaf-bob" 165 ("https://crates.io/api/v1/crates/foo"
554 (list rust-leaf-bob-3.0.2-yanked)) 166 (open-input-string test-foo-crate))
555 (_ '())))) 167 ("https://crates.io/api/v1/crates/foo/1.0.3/download"
556 (mock 168 (set! test-source-hash
557 ((guix http-client) http-fetch 169 (bytevector->nix-base32-string
558 (lambda (url . rest) 170 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
559 (match url 171 (open-input-string "empty file\n"))
560 ("https://crates.io/api/v1/crates/intermediate-b" 172 (_ (error "Unexpected URL: " url)))))
561 (open-input-string test-intermediate-b-crate))
562 ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/download"
563 (set! test-source-hash
564 (bytevector->nix-base32-string
565 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
566 (open-input-string "empty file\n"))
567 ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/dependencies"
568 (open-input-string test-intermediate-b-dependencies))
569 ("https://crates.io/api/v1/crates/leaf-bob"
570 (open-input-string test-leaf-bob-crate))
571 ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
572 (set! test-source-hash
573 (bytevector->nix-base32-string
574 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
575 (open-input-string "empty file\n"))
576 (_ (error "Unexpected URL: " url)))))
577 (match (crate->guix-package "intermediate-b" #:mark-missing? #t)
578 ((define-public 'rust-intermediate-b-1
579 (package
580 (name "rust-intermediate-b")
581 (version "1.2.3")
582 (source
583 (origin
584 (method url-fetch)
585 (uri (crate-uri "intermediate-b" version))
586 (file-name
587 (string-append name "-" version ".tar.gz"))
588 (sha256
589 (base32
590 (? string? hash)))))
591 (build-system cargo-build-system)
592 (arguments
593 ('quasiquote
594 (#:skip-build? #t
595 #:cargo-inputs
596 (($ <comment> ";; rust-leaf-bob-3\n" #f)))))
597 (home-page "http://example.com")
598 (synopsis "summary")
599 (description "This package provides summary.")
600 (license (list license:expat license:asl2.0))))
601 #t)
602 (x
603 (pk 'fail
604 (pretty-print-with-comments (current-output-port) x)
605 #f))))))
606 173
607(unless have-guile-semver? (test-skip 1)) 174 (match (crate->guix-package "foo" #:version "1.0.3" #:allow-yanked? #t)
608(test-assert "crate-recursive-import" 175 (`(define-public foo
609 ;; Replace network resources with sample data. 176 (package (name "foo")
610 (mock ((guix http-client) http-fetch 177 (version "1.0.3")
611 (lambda (url . rest) 178 ,(? comment?)
612 (match url 179 (source
613 ("https://crates.io/api/v1/crates/root" 180 (origin
614 (open-input-string test-root-crate)) 181 (method url-fetch)
615 ("https://crates.io/api/v1/crates/root/1.0.4/download" 182 (uri (crate-uri "foo" version))
616 (set! test-source-hash 183 (file-name (string-append name "-" version "-yanked.tar.gz"))
617 (bytevector->nix-base32-string 184 (sha256
618 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 185 (base32
619 (open-input-string "empty file\n")) 186 ,(? string? hash)))))
620 ("https://crates.io/api/v1/crates/root/1.0.4/dependencies" 187 (properties '((crate-version-yanked? . #t)))
621 (open-input-string test-root-dependencies)) 188 (build-system cargo-build-system)
622 ("https://crates.io/api/v1/crates/intermediate-a" 189 (inputs (cargo-inputs 'foo))
623 (open-input-string test-intermediate-a-crate)) 190 (home-page "http://example.com")
624 ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/download" 191 (synopsis "summary")
625 (set! test-source-hash 192 (description "This package provides summary.")
626 (bytevector->nix-base32-string 193 (license (list license:expat license:asl2.0))))
627 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 194 (string=? test-source-hash hash))
628 (open-input-string "empty file\n")) 195 (x
629 ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/dependencies" 196 (pk 'fail x #f)))))
630 (open-input-string test-intermediate-a-dependencies)) 197
631 ("https://crates.io/api/v1/crates/intermediate-b" 198(test-assert "crate->guix-package only yanked available"
632 (open-input-string test-intermediate-b-crate)) 199 (mock
633 ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/download" 200 ((guix http-client) http-fetch
634 (set! test-source-hash 201 (lambda (url . rest)
635 (bytevector->nix-base32-string 202 (match url
636 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 203 ("https://crates.io/api/v1/crates/bar"
637 (open-input-string "empty file\n")) 204 (open-input-string test-foo-crate))
638 ("https://crates.io/api/v1/crates/intermediate-b/1.2.3/dependencies" 205 ("https://crates.io/api/v1/crates/bar/1.0.0/download"
639 (open-input-string test-intermediate-b-dependencies)) 206 (set! test-source-hash
640 ("https://crates.io/api/v1/crates/intermediate-c" 207 (bytevector->nix-base32-string
641 (open-input-string test-intermediate-c-crate)) 208 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
642 ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/download" 209 (open-input-string "empty file\n"))
643 (set! test-source-hash 210 (_ (error "Unexpected URL: " url)))))
644 (bytevector->nix-base32-string 211
645 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 212 (match (crate->guix-package "bar")
646 (open-input-string "empty file\n")) 213 (`(define-public bar
647 ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/dependencies" 214 (package (name "bar")
648 (open-input-string test-intermediate-c-dependencies)) 215 (version "1.0.0")
649 ("https://crates.io/api/v1/crates/leaf-alice" 216 (source
650 (open-input-string test-leaf-alice-crate)) 217 (origin
651 ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download" 218 (method url-fetch)
652 (set! test-source-hash 219 (uri (crate-uri "bar" version))
653 (bytevector->nix-base32-string 220 (file-name
654 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 221 (string-append name "-" version ".tar.gz"))
655 (open-input-string "empty file\n")) 222 (sha256
656 ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies" 223 (base32
657 (open-input-string test-leaf-alice-dependencies)) 224 ,(? string? hash)))))
658 ("https://crates.io/api/v1/crates/leaf-bob" 225 (build-system cargo-build-system)
659 (open-input-string test-leaf-bob-crate)) 226 (inputs (cargo-inputs 'bar))
660 ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download" 227 (home-page "http://example.com")
661 (set! test-source-hash 228 (synopsis "summary")
662 (bytevector->nix-base32-string 229 (description "This package provides summary.")
663 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8")))) 230 (license (list license:expat license:asl2.0))))
664 (open-input-string "empty file\n")) 231 (string=? test-source-hash hash))
665 ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies" 232 (x
666 (open-input-string test-leaf-bob-dependencies)) 233 (pk 'fail x #f)))))
667 (_ (error "Unexpected URL: " url)))))
668 (match (crate-recursive-import "root")
669 ;; rust-intermediate-b has no dependency on the rust-leaf-alice
670 ;; package, so this is a valid ordering
671 (((define-public 'rust-intermediate-c-1
672 (package
673 (name "rust-intermediate-c")
674 (version "1.0.1")
675 (source
676 (origin
677 (method url-fetch)
678 (uri (crate-uri "intermediate-c" version))
679 (file-name
680 (string-append name "-" version ".tar.gz"))
681 (sha256
682 (base32
683 (? string? hash)))))
684 (build-system cargo-build-system)
685 (arguments
686 ('quasiquote (#:skip-build? #t)))
687 (home-page "http://example.com")
688 (synopsis "summary")
689 (description "This package provides summary.")
690 (license (list license:expat license:asl2.0))))
691 (define-public 'rust-leaf-alice-0.7
692 (package
693 (name "rust-leaf-alice")
694 (version "0.7.5")
695 (source
696 (origin
697 (method url-fetch)
698 (uri (crate-uri "leaf-alice" version))
699 (file-name
700 (string-append name "-" version ".tar.gz"))
701 (sha256
702 (base32
703 (? string? hash)))))
704 (build-system cargo-build-system)
705 (arguments ('quasiquote (#:skip-build? #t)))
706 (home-page "http://example.com")
707 (synopsis "summary")
708 (description "This package provides summary.")
709 (license (list license:expat license:asl2.0))))
710 (define-public 'rust-leaf-bob-3
711 (package
712 (name "rust-leaf-bob")
713 (version "3.0.1")
714 (source
715 (origin
716 (method url-fetch)
717 (uri (crate-uri "leaf-bob" version))
718 (file-name
719 (string-append name "-" version ".tar.gz"))
720 (sha256
721 (base32
722 (? string? hash)))))
723 (build-system cargo-build-system)
724 (arguments ('quasiquote (#:skip-build? #t)))
725 (home-page "http://example.com")
726 (synopsis "summary")
727 (description "This package provides summary.")
728 (license (list license:expat license:asl2.0))))
729 (define-public 'rust-intermediate-b-1
730 (package
731 (name "rust-intermediate-b")
732 (version "1.2.3")
733 (source
734 (origin
735 (method url-fetch)
736 (uri (crate-uri "intermediate-b" version))
737 (file-name
738 (string-append name "-" version ".tar.gz"))
739 (sha256
740 (base32
741 (? string? hash)))))
742 (build-system cargo-build-system)
743 (arguments
744 ('quasiquote (#:skip-build? #t
745 #:cargo-inputs
746 (("rust-leaf-bob"
747 ('unquote rust-leaf-bob-3))))))
748 (home-page "http://example.com")
749 (synopsis "summary")
750 (description "This package provides summary.")
751 (license (list license:expat license:asl2.0))))
752 (define-public 'rust-intermediate-a-1
753 (package
754 (name "rust-intermediate-a")
755 (version "1.0.42")
756 (source
757 (origin
758 (method url-fetch)
759 (uri (crate-uri "intermediate-a" version))
760 (file-name
761 (string-append name "-" version ".tar.gz"))
762 (sha256
763 (base32
764 (? string? hash)))))
765 (build-system cargo-build-system)
766 (arguments
767 ('quasiquote (#:skip-build? #t
768 #:cargo-inputs
769 (("rust-intermediate-b"
770 ('unquote rust-intermediate-b-1))
771 ("rust-leaf-alice"
772 ('unquote 'rust-leaf-alice-0.7))
773 ("rust-leaf-bob"
774 ('unquote rust-leaf-bob-3))))))
775 (home-page "http://example.com")
776 (synopsis "summary")
777 (description "This package provides summary.")
778 (license (list license:expat license:asl2.0))))
779 (define-public 'rust-root-1
780 (package
781 (name "rust-root")
782 (version "1.0.4")
783 (source
784 (origin
785 (method url-fetch)
786 (uri (crate-uri "root" version))
787 (file-name
788 (string-append name "-" version ".tar.gz"))
789 (sha256
790 (base32
791 (? string? hash)))))
792 (build-system cargo-build-system)
793 (arguments
794 ('quasiquote (#:cargo-inputs
795 (("rust-intermediate-a"
796 ('unquote rust-intermediate-a-1))
797 ("rust-intermediate-b"
798 ('unquote rust-intermediate-b-1))
799 ("rust-leaf-alice"
800 ('unquote 'rust-leaf-alice-0.7))
801 ("rust-leaf-bob"
802 ('unquote rust-leaf-bob-3)))
803 #:cargo-development-inputs
804 (("rust-intermediate-c"
805 ('unquote rust-intermediate-c-1))))))
806 (home-page "http://example.com")
807 (synopsis "summary")
808 (description "This package provides summary.")
809 (license (list license:expat license:asl2.0)))))
810 #t)
811 (x
812 (pk 'fail x #f)))
813 (match (crate-recursive-import "root"
814 #:recursive-dev-dependencies? #t)
815 ;; rust-intermediate-b has no dependency on the rust-leaf-alice
816 ;; package, so this is a valid ordering
817 (((define-public 'rust-intermediate-c-1
818 (package
819 (name "rust-intermediate-c")
820 (version "1.0.1")
821 (source
822 (origin
823 (method url-fetch)
824 (uri (crate-uri "intermediate-c" version))
825 (file-name
826 (string-append name "-" version ".tar.gz"))
827 (sha256
828 (base32
829 (? string? hash)))))
830 (build-system cargo-build-system)
831 (arguments
832 ('quasiquote (#:cargo-development-inputs
833 (("rust-leaf-alice"
834 ('unquote rust-leaf-alice-0.7))))))
835 (home-page "http://example.com")
836 (synopsis "summary")
837 (description "This package provides summary.")
838 (license (list license:expat license:asl2.0))))
839 (define-public 'rust-leaf-alice-0.7
840 (package
841 (name "rust-leaf-alice")
842 (version "0.7.5")
843 (source
844 (origin
845 (method url-fetch)
846 (uri (crate-uri "leaf-alice" version))
847 (file-name
848 (string-append name "-" version ".tar.gz"))
849 (sha256
850 (base32
851 (? string? hash)))))
852 (build-system cargo-build-system)
853 (home-page "http://example.com")
854 (synopsis "summary")
855 (description "This package provides summary.")
856 (license (list license:expat license:asl2.0))))
857 (define-public 'rust-leaf-bob-3
858 (package
859 (name "rust-leaf-bob")
860 (version "3.0.1")
861 (source
862 (origin
863 (method url-fetch)
864 (uri (crate-uri "leaf-bob" version))
865 (file-name
866 (string-append name "-" version ".tar.gz"))
867 (sha256
868 (base32
869 (? string? hash)))))
870 (build-system cargo-build-system)
871 (home-page "http://example.com")
872 (synopsis "summary")
873 (description "This package provides summary.")
874 (license (list license:expat license:asl2.0))))
875 (define-public 'rust-intermediate-b-1
876 (package
877 (name "rust-intermediate-b")
878 (version "1.2.3")
879 (source
880 (origin
881 (method url-fetch)
882 (uri (crate-uri "intermediate-b" version))
883 (file-name
884 (string-append name "-" version ".tar.gz"))
885 (sha256
886 (base32
887 (? string? hash)))))
888 (build-system cargo-build-system)
889 (arguments
890 ('quasiquote (#:cargo-inputs
891 (("rust-leaf-bob"
892 ('unquote rust-leaf-bob-3))))))
893 (home-page "http://example.com")
894 (synopsis "summary")
895 (description "This package provides summary.")
896 (license (list license:expat license:asl2.0))))
897 (define-public 'rust-intermediate-a-1
898 (package
899 (name "rust-intermediate-a")
900 (version "1.0.42")
901 (source
902 (origin
903 (method url-fetch)
904 (uri (crate-uri "intermediate-a" version))
905 (file-name
906 (string-append name "-" version ".tar.gz"))
907 (sha256
908 (base32
909 (? string? hash)))))
910 (build-system cargo-build-system)
911 (arguments
912 ('quasiquote (#:cargo-inputs
913 (("rust-intermediate-b"
914 ('unquote rust-intermediate-b-1))
915 ("rust-leaf-alice"
916 ('unquote 'rust-leaf-alice-0.7))
917 ("rust-leaf-bob"
918 ('unquote rust-leaf-bob-3))))))
919 (home-page "http://example.com")
920 (synopsis "summary")
921 (description "This package provides summary.")
922 (license (list license:expat license:asl2.0))))
923 (define-public 'rust-root-1
924 (package
925 (name "rust-root")
926 (version "1.0.4")
927 (source
928 (origin
929 (method url-fetch)
930 (uri (crate-uri "root" version))
931 (file-name
932 (string-append name "-" version ".tar.gz"))
933 (sha256
934 (base32
935 (? string? hash)))))
936 (build-system cargo-build-system)
937 (arguments
938 ('quasiquote (#:cargo-inputs
939 (("rust-intermediate-a"
940 ('unquote rust-intermediate-a-1))
941 ("rust-intermediate-b"
942 ('unquote rust-intermediate-b-1))
943 ("rust-leaf-alice"
944 ('unquote 'rust-leaf-alice-0.7))
945 ("rust-leaf-bob"
946 ('unquote rust-leaf-bob-3))
947 ("rust-leaf-bob"
948 ('unquote rust-leaf-bob-3)))
949 #:cargo-development-inputs
950 (("rust-intermediate-c"
951 ('unquote rust-intermediate-c-1))))))
952 (home-page "http://example.com")
953 (synopsis "summary")
954 (description "This package provides summary.")
955 (license (list license:expat license:asl2.0)))))
956 #t)
957 (x
958 (pk 'fail x #f)))))
959 234
960(test-equal "licenses: MIT OR Apache-2.0" 235(test-equal "licenses: MIT OR Apache-2.0"
961 '(license:expat license:asl2.0) 236 '(license:expat license:asl2.0)
@@ -977,211 +252,6 @@
977 '(license:expat license:asl2.0) 252 '(license:expat license:asl2.0)
978 (string->license "MIT/Apache-2.0")) 253 (string->license "MIT/Apache-2.0"))
979 254
980
981
982(unless have-guile-semver? (test-skip 1))
983(test-assert "crate-recursive-import-honors-existing-packages"
984 (mock
985 ((gnu packages) find-packages-by-name
986 (lambda* (name #:optional version)
987 (match name
988 ("rust-leaf-bob"
989 (list rust-leaf-bob-3 rust-leaf-bob-3.0.2-yanked))
990 (_ '()))))
991 (mock
992 ((guix http-client) http-fetch
993 (lambda (url . rest)
994 (match url
995 ("https://crates.io/api/v1/crates/bar"
996 (open-input-string test-bar-crate))
997 ("https://crates.io/api/v1/crates/bar/1.0.0/download"
998 (set! test-source-hash
999 (bytevector->nix-base32-string
1000 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1001 (open-input-string "empty file\n"))
1002 ("https://crates.io/api/v1/crates/bar/1.0.0/dependencies"
1003 (open-input-string test-bar-dependencies))
1004 ("https://crates.io/api/v1/crates/leaf-bob"
1005 (open-input-string test-leaf-bob-crate))
1006 ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/download"
1007 (set! test-source-hash
1008 (bytevector->nix-base32-string
1009 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1010 (open-input-string "empty file\n"))
1011 ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
1012 (open-input-string test-leaf-bob-dependencies))
1013 ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
1014 (set! test-source-hash
1015 (bytevector->nix-base32-string
1016 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1017 (open-input-string "empty file\n"))
1018 ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
1019 (open-input-string test-leaf-bob-dependencies))
1020 (_ (error "Unexpected URL: " url)))))
1021 (match (crate-recursive-import "bar"
1022 #:allow-yanked? #t)
1023 (((define-public 'rust-bar-1
1024 (package
1025 (name "rust-bar")
1026 (version "1.0.0")
1027 (source
1028 (origin
1029 (method url-fetch)
1030 (uri (crate-uri "bar" version))
1031 (file-name
1032 (string-append name "-" version ".tar.gz"))
1033 (sha256
1034 (base32
1035 (? string? hash)))))
1036 (build-system cargo-build-system)
1037 (arguments
1038 ('quasiquote (#:cargo-inputs
1039 (("rust-leaf-bob"
1040 ('unquote 'rust-leaf-bob-3)))
1041 #:cargo-development-inputs
1042 (("rust-leaf-bob"
1043 ('unquote 'rust-leaf-bob-3.0.2-yanked))
1044 ("rust-leaf-bob"
1045 ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
1046 (home-page "http://example.com")
1047 (synopsis "summary")
1048 (description "This package provides summary.")
1049 (license (list license:expat license:asl2.0)))))
1050 #t)
1051 (x
1052 (pk 'fail x #f))))))
1053
1054(unless have-guile-semver? (test-skip 1))
1055(test-assert "crate-import-only-yanked-available"
1056 (mock
1057 ((guix http-client) http-fetch
1058 (lambda (url . rest)
1059 (match url
1060 ("https://crates.io/api/v1/crates/bar"
1061 (open-input-string test-bar-crate))
1062 ("https://crates.io/api/v1/crates/bar/1.0.0/download"
1063 (set! test-source-hash
1064 (bytevector->nix-base32-string
1065 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1066 (open-input-string "empty file\n"))
1067 ("https://crates.io/api/v1/crates/bar/1.0.0/dependencies"
1068 (open-input-string test-bar-dependencies))
1069 ("https://crates.io/api/v1/crates/leaf-bob"
1070 (open-input-string test-leaf-bob-crate))
1071 ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
1072 (set! test-source-hash
1073 (bytevector->nix-base32-string
1074 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1075 (open-input-string "empty file\n"))
1076 ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
1077 (open-input-string test-leaf-bob-dependencies))
1078 ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/download"
1079 (set! test-source-hash
1080 (bytevector->nix-base32-string
1081 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1082 (open-input-string "empty file\n"))
1083 ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
1084 (open-input-string test-leaf-bob-dependencies))
1085 ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
1086 (set! test-source-hash
1087 (bytevector->nix-base32-string
1088 (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
1089 (open-input-string "empty file\n"))
1090 ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
1091 (open-input-string test-leaf-bob-dependencies))
1092 (_ (error "Unexpected URL: " url)))))
1093 (match (crate-recursive-import "bar"
1094 #:recursive-dev-dependencies? #t
1095 #:allow-yanked? #t)
1096 (((define-public 'rust-leaf-bob-4.0.0-yanked
1097 (package
1098 (name "rust-leaf-bob")
1099 (version "4.0.0")
1100 ($ <comment> "; This version was yanked!\n" #t)
1101 (source
1102 (origin
1103 (method url-fetch)
1104 (uri (crate-uri "leaf-bob" version))
1105 (file-name
1106 (string-append name "-" version "-yanked.tar.gz"))
1107 (sha256
1108 (base32
1109 (? string? hash)))))
1110 (properties ('quote (('crate-version-yanked? . #t))))
1111 (build-system cargo-build-system)
1112 (home-page "http://example.com")
1113 (synopsis "summary")
1114 (description "This package provides summary.")
1115 (license (list license:expat license:asl2.0))))
1116 (define-public 'rust-leaf-bob-3.0.2-yanked
1117 (package
1118 (name "rust-leaf-bob")
1119 (version "3.0.2")
1120 ($ <comment> "; This version was yanked!\n" #t)
1121 (source
1122 (origin
1123 (method url-fetch)
1124 (uri (crate-uri "leaf-bob" version))
1125 (file-name
1126 (string-append name "-" version "-yanked.tar.gz"))
1127 (sha256
1128 (base32
1129 (? string? hash)))))
1130 (properties ('quote (('crate-version-yanked? . #t))))
1131 (build-system cargo-build-system)
1132 (home-page "http://example.com")
1133 (synopsis "summary")
1134 (description "This package provides summary.")
1135 (license (list license:expat license:asl2.0))))
1136 (define-public 'rust-leaf-bob-3
1137 (package
1138 (name "rust-leaf-bob")
1139 (version "3.0.1")
1140 (source
1141 (origin
1142 (method url-fetch)
1143 (uri (crate-uri "leaf-bob" version))
1144 (file-name
1145 (string-append name "-" version ".tar.gz"))
1146 (sha256
1147 (base32
1148 (? string? hash)))))
1149 (build-system cargo-build-system)
1150 (home-page "http://example.com")
1151 (synopsis "summary")
1152 (description "This package provides summary.")
1153 (license (list license:expat license:asl2.0))))
1154 (define-public 'rust-bar-1
1155 (package
1156 (name "rust-bar")
1157 (version "1.0.0")
1158 (source
1159 (origin
1160 (method url-fetch)
1161 (uri (crate-uri "bar" version))
1162 (file-name
1163 (string-append name "-" version ".tar.gz"))
1164 (sha256
1165 (base32
1166 (? string? hash)))))
1167 (build-system cargo-build-system)
1168 (arguments
1169 ('quasiquote (#:cargo-inputs
1170 (("rust-leaf-bob"
1171 ('unquote 'rust-leaf-bob-3)))
1172 #:cargo-development-inputs
1173 (("rust-leaf-bob"
1174 ('unquote 'rust-leaf-bob-3.0.2-yanked))
1175 ("rust-leaf-bob"
1176 ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
1177 (home-page "http://example.com")
1178 (synopsis "summary")
1179 (description "This package provides summary.")
1180 (license (list license:expat license:asl2.0)))))
1181 #t)
1182 (x
1183 (pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))
1184
1185 255
1186(test-assert "crate-lockfile-import" 256(test-assert "crate-lockfile-import"
1187 (begin 257 (begin