projects/guix·blob master · refs

165 lines · 5.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Jelle Licht <[email protected]>
3;;; Copyright © 2025 Nicolas Graves <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19(define-module (test-npm-binary)
20 #:use-module ((gcrypt hash)
21 #:select ((sha256 . gcrypt-sha256)))
22 #:use-module (guix import npm-binary)
23 #:use-module (guix base32)
24 #:use-module (guix tests)
25 #:use-module (srfi srfi-64)
26 #:use-module (ice-9 iconv)
27 #:use-module (ice-9 match)
28 #:use-module (json)
29 #:export (run-test))
30
31(define* (foo-json #:key (license "MIT"))
32 "Create a JSON description of an example foo npm package, optionally using a
33different @var{license}."
34 (scm->json-string
35 `((name . "foo")
36 (dist-tags . ((latest . "1.2.3")
37 (next . "2.0.1-beta4")))
38 (description . "General purpose utilities to foo your bars")
39 (homepage . "https://github.com/quartz/foo")
40 (repository . "quartz/foo")
41 (versions
42 . ((1.2.3
43 . ((name . "foo")
44 (description . "General purpose utilities to foo your bars")
45 (version . "1.2.3")
46 (author . "Jelle Licht <[email protected]>")
47 (devDependencies . ((node-megabuilder . "^0.0.2")))
48 (dependencies . ((bar . "^0.1.0")))
49 (repository . ((url . "quartz/foo")))
50 (homepage . "https://github.com/quartz/foo")
51 (license . ,license)
52 (dist
53 . ((tarball
54 . "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"))))))))))
55
56;; Dependency JSON for the bar package
57(define bar-json
58 "{
59 \"name\": \"bar\",
60 \"dist-tags\": {
61 \"latest\": \"0.1.2\"
62 },
63 \"description\": \"Core module in FooBar\",
64 \"homepage\": \"https://github.com/quartz/bar\",
65 \"repository\": \"quartz/bar\",
66 \"versions\": {
67 \"0.1.2\": {
68 \"name\": \"bar\",
69 \"description\": \"Core module in FooBar\",
70 \"version\": \"0.1.2\",
71 \"author\": \"Jelle Licht <[email protected]>\",
72 \"repository\": {
73 \"url\": \"quartz/bar\"
74 },
75 \"homepage\": \"https://github.com/quartz/bar\",
76 \"license\": \"MIT\",
77 \"dist\": {
78 \"tarball\": \"https://registry.npmjs.org/bar/-/bar-0.1.2.tgz\"
79 }
80 }
81 }
82}")
83
84(define test-source
85 "Empty file\n")
86
87(define test-source-hash
88 (bytevector->nix-base32-string
89 (gcrypt-sha256 (string->bytevector test-source "utf-8"))))
90
91(define have-guile-semver?
92 (false-if-exception (resolve-interface '(semver))))
93
94(define* (foo-sexp #:key (license 'license:expat))
95 `(package
96 (name "node-foo")
97 (version "1.2.3")
98 (source (origin
99 (method url-fetch)
100 (uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
101 (sha256
102 (base32 "1n0h7zg9zzv4f7yn2gp0mq1v107im7pi6qq4k6q86rixz71ijklh"))))
103 (build-system node-build-system)
104 (arguments
105 (list #:tests? #f
106 #:phases
107 (gexp (modify-phases %standard-phases
108 (delete 'build)
109 (add-after 'patch-dependencies 'delete-dev-dependencies
110 (lambda _
111 (modify-json
112 (delete-dependencies '("node-megabuilder")))))))))
113 (inputs (list node-bar-0.1.2))
114 (home-page "https://github.com/quartz/foo")
115 (synopsis "General purpose utilities to foo your bars")
116 (description "General purpose utilities to foo your bars")
117 (license ,license)))
118
119(test-begin "npm")
120
121(unless have-guile-semver? (test-skip 1))
122(test-assert "npm-binary->guix-package base case"
123 (mock ((guix http-client) http-fetch
124 (lambda* (url #:rest _)
125 (match url
126 ("https://registry.npmjs.org/foo"
127 (let ((json-foo (foo-json)))
128 (values (open-input-string json-foo)
129 (string-length json-foo))))
130 ("https://registry.npmjs.org/bar"
131 (values (open-input-string bar-json)
132 (string-length bar-json)))
133 ("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
134 (values (open-input-string test-source)
135 (string-length test-source))))))
136 (let ((sexp-foo (foo-sexp)))
137 (match (npm-binary->guix-package "foo")
138 (sexp-foo
139 #t)
140 (x
141 (pk 'fail x #f))))))
142
143(test-assert "npm-binary->guix-package with multiple licenses"
144 (mock ((guix http-client) http-fetch
145 (lambda* (url #:rest _)
146 (match url
147 ("https://registry.npmjs.org/foo"
148 (let ((json-foo (foo-json #:license #("MIT" "Apache2.0"))))
149 (values (open-input-string json-foo)
150 (string-length json-foo))))
151 ("https://registry.npmjs.org/bar"
152 (values (open-input-string bar-json)
153 (string-length bar-json)))
154 ("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
155 (values (open-input-string test-source)
156 (string-length test-source))))))
157 (let ((sexp-foo (foo-sexp
158 #:license '(list license:expat license:asl2.0))))
159 (match (npm-binary->guix-package "foo")
160 (sexp-foo
161 #t)
162 (x
163 (pk 'fail x #f))))))
164
165(test-end "npm")