;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2024 Jelle Licht ;;; Copyright © 2025 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (test-npm-binary) #:use-module ((gcrypt hash) #:select ((sha256 . gcrypt-sha256))) #:use-module (guix import npm-binary) #:use-module (guix base32) #:use-module (guix tests) #:use-module (srfi srfi-64) #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (json) #:export (run-test)) (define* (foo-json #:key (license "MIT")) "Create a JSON description of an example foo npm package, optionally using a different @var{license}." (scm->json-string `((name . "foo") (dist-tags . ((latest . "1.2.3") (next . "2.0.1-beta4"))) (description . "General purpose utilities to foo your bars") (homepage . "https://github.com/quartz/foo") (repository . "quartz/foo") (versions . ((1.2.3 . ((name . "foo") (description . "General purpose utilities to foo your bars") (version . "1.2.3") (author . "Jelle Licht ") (devDependencies . ((node-megabuilder . "^0.0.2"))) (dependencies . ((bar . "^0.1.0"))) (repository . ((url . "quartz/foo"))) (homepage . "https://github.com/quartz/foo") (license . ,license) (dist . ((tarball . "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")))))))))) ;; Dependency JSON for the bar package (define bar-json "{ \"name\": \"bar\", \"dist-tags\": { \"latest\": \"0.1.2\" }, \"description\": \"Core module in FooBar\", \"homepage\": \"https://github.com/quartz/bar\", \"repository\": \"quartz/bar\", \"versions\": { \"0.1.2\": { \"name\": \"bar\", \"description\": \"Core module in FooBar\", \"version\": \"0.1.2\", \"author\": \"Jelle Licht \", \"repository\": { \"url\": \"quartz/bar\" }, \"homepage\": \"https://github.com/quartz/bar\", \"license\": \"MIT\", \"dist\": { \"tarball\": \"https://registry.npmjs.org/bar/-/bar-0.1.2.tgz\" } } } }") (define test-source "Empty file\n") (define test-source-hash (bytevector->nix-base32-string (gcrypt-sha256 (string->bytevector test-source "utf-8")))) (define have-guile-semver? (false-if-exception (resolve-interface '(semver)))) (define* (foo-sexp #:key (license 'license:expat)) `(package (name "node-foo") (version "1.2.3") (source (origin (method url-fetch) (uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz") (sha256 (base32 "1n0h7zg9zzv4f7yn2gp0mq1v107im7pi6qq4k6q86rixz71ijklh")))) (build-system node-build-system) (arguments (list #:tests? #f #:phases (gexp (modify-phases %standard-phases (delete 'build) (add-after 'patch-dependencies 'delete-dev-dependencies (lambda _ (modify-json (delete-dependencies '("node-megabuilder"))))))))) (inputs (list node-bar-0.1.2)) (home-page "https://github.com/quartz/foo") (synopsis "General purpose utilities to foo your bars") (description "General purpose utilities to foo your bars") (license ,license))) (test-begin "npm") (unless have-guile-semver? (test-skip 1)) (test-assert "npm-binary->guix-package base case" (mock ((guix http-client) http-fetch (lambda* (url #:rest _) (match url ("https://registry.npmjs.org/foo" (let ((json-foo (foo-json))) (values (open-input-string json-foo) (string-length json-foo)))) ("https://registry.npmjs.org/bar" (values (open-input-string bar-json) (string-length bar-json))) ("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz" (values (open-input-string test-source) (string-length test-source)))))) (let ((sexp-foo (foo-sexp))) (match (npm-binary->guix-package "foo") (sexp-foo #t) (x (pk 'fail x #f)))))) (test-assert "npm-binary->guix-package with multiple licenses" (mock ((guix http-client) http-fetch (lambda* (url #:rest _) (match url ("https://registry.npmjs.org/foo" (let ((json-foo (foo-json #:license #("MIT" "Apache2.0")))) (values (open-input-string json-foo) (string-length json-foo)))) ("https://registry.npmjs.org/bar" (values (open-input-string bar-json) (string-length bar-json))) ("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz" (values (open-input-string test-source) (string-length test-source)))))) (let ((sexp-foo (foo-sexp #:license '(list license:expat license:asl2.0)))) (match (npm-binary->guix-package "foo") (sexp-foo #t) (x (pk 'fail x #f)))))) (test-end "npm")