[PATCH] guix import: Add proper guix-hash-url

OpenSubmitted by Robert Vollmert.
Details
One participant
  • Robert Vollmert
Owner
unassigned
Severity
normal
R
R
Robert Vollmert wrote on 15 Jul 2019 12:59
Download
(address . guix-patches@gnu.org)(name . Robert Vollmert)(address . rob@vllmrt.net)
20190715105933.23964-1-rob@vllmrt.net
Download
* guix/import/utils.scm (guix-hash-url): Rename to...
(guix-hash-file): this.
(guix-hash-url): New function that does what it's called.
* guix/import/opam.scm (opam->guix-package): Use guix-hash-url.
* tests/opam.scm: Mock guix-hash-url instead.
---
guix/import/opam.scm | 65 +++++++++++++++--------------
guix/import/utils.scm | 12 +++++-
tests/opam.scm | 95 ++++++++++++++++++++-----------------------
3 files changed, 87 insertions(+), 85 deletions(-)

Toggle diff (237 lines)
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index 5dcc0e97a3..724302d0c5 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -263,39 +263,38 @@ path to the repository."
         ;; If one of these are required at build time, it means we
         ;; can use the much nicer dune-build-system.
         (let ((use-dune? (or (member "dune" native-dependencies)
-                        (member "jbuilder" native-dependencies))))
-          (call-with-temporary-output-file
-            (lambda (temp port)
-              (and (url-fetch source-url temp)
-                   (values
-                    `(package
-                       (name ,(ocaml-name->guix-name name))
-                       (version ,(if (string-prefix? "v" version)
-                                   (substring version 1)
-                                   version))
-                       (source
-                         (origin
-                           (method url-fetch)
-                           (uri ,source-url)
-                           (sha256 (base32 ,(guix-hash-url temp)))))
-                       (build-system ,(if use-dune?
-                                          'dune-build-system
-                                          'ocaml-build-system))
-                       ,@(if (null? inputs)
-                           '()
-                           `((inputs ,(list 'quasiquote inputs))))
-                       ,@(if (null? native-inputs)
-                           '()
-                           `((native-inputs ,(list 'quasiquote native-inputs))))
-                       ,@(if (equal? name (guix-name->opam-name (ocaml-name->guix-name name)))
-                           '()
-                           `((properties
-                               ,(list 'quasiquote `((upstream-name . ,name))))))
-                       (home-page ,(metadata-ref opam-content "homepage"))
-                       (synopsis ,(metadata-ref opam-content "synopsis"))
-                       (description ,(metadata-ref opam-content "description"))
-                       (license #f))
-                    dependencies)))))))
+                        (member "jbuilder" native-dependencies)))
+              (hash (guix-hash-url source-url)))
+          (and hash
+               (values
+                `(package
+                   (name ,(ocaml-name->guix-name name))
+                   (version ,(if (string-prefix? "v" version)
+                               (substring version 1)
+                               version))
+                   (source
+                     (origin
+                       (method url-fetch)
+                       (uri ,source-url)
+                       (sha256 (base32 ,hash))))
+                   (build-system ,(if use-dune?
+                                      'dune-build-system
+                                      'ocaml-build-system))
+                   ,@(if (null? inputs)
+                       '()
+                       `((inputs ,(list 'quasiquote inputs))))
+                   ,@(if (null? native-inputs)
+                       '()
+                       `((native-inputs ,(list 'quasiquote native-inputs))))
+                   ,@(if (equal? name (guix-name->opam-name (ocaml-name->guix-name name)))
+                       '()
+                       `((properties
+                           ,(list 'quasiquote `((upstream-name . ,name))))))
+                   (home-page ,(metadata-ref opam-content "homepage"))
+                   (synopsis ,(metadata-ref opam-content "synopsis"))
+                   (description ,(metadata-ref opam-content "description"))
+                   (license #f))
+                dependencies)))))
 
 (define (opam-recursive-import package-name)
   (recursive-import package-name #f
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 0dfd4959a8..5eb8abbbed 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -50,6 +50,7 @@
             assoc-ref*
 
             url-fetch
+            guix-hash-file
             guix-hash-url
 
             package-names->package-inputs
@@ -137,10 +138,17 @@ recursively apply the procedure to the sub-list."
   (parameterize ((current-output-port (current-error-port)))
     (build:url-fetch url file-name)))
 
-(define (guix-hash-url filename)
+(define (guix-hash-file filename)
   "Return the hash of FILENAME in nix-base32 format."
   (bytevector->nix-base32-string (file-sha256 filename)))
 
+(define (guix-hash-url url)
+  "Return the hash of URL in nix-base32 format."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (and (url-fetch url temp)
+          (guix-hash-file temp)))))
+
 (define (spdx-string->license str)
   "Convert STR, a SPDX formatted license identifier, to a license object.
    Return #f if STR does not match any known identifiers."
@@ -305,7 +313,7 @@ the expected fields of an <origin> object."
        (origin
          (method url-fetch)
          (uri source-url)
-         (sha256 (base32 (guix-hash-url tarball))))))
+         (sha256 (base32 (guix-hash-file tarball))))))
     (#f #f)
     (orig (let ((sha (match (assoc-ref orig "sha256")
                        ((("base32" . value))
diff --git a/tests/opam.scm b/tests/opam.scm
index e8c0d15198..6357758208 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -31,7 +31,7 @@
   #:use-module (ice-9 peg))
 
 (define test-opam-file
-"opam-version: \"2.0\"
+  "opam-version: \"2.0\"
   version: \"1.0.0\"
 maintainer: \"Alice Doe\"
 authors: [
@@ -60,61 +60,56 @@ url {
   checksum: \"md5=74c6e897658e820006106f45f736381f\"
 }")
 
-(define test-source-hash
-  "")
-
 (define test-repo
   (mkdtemp! "/tmp/opam-repo.XXXXXX"))
 
+(define %test-hash
+  "0w83v9ylycsssyn47q8wnkfbvhn5vn10z6i35n5965i2m1r0mmcf")
+
 (test-begin "opam")
 
 (test-assert "opam->guix-package"
-  (mock ((guix import utils) url-fetch
-         (lambda (url file-name)
-           (match url
-             ("https://example.org/foo-1.0.0.tar.gz"
-              (begin
-                (mkdir-p "foo-1.0.0")
-                (system* "tar" "czvf" file-name "foo-1.0.0/")
-                (delete-file-recursively "foo-1.0.0")
-                (set! test-source-hash
-                  (call-with-input-file file-name port-sha256))))
-             (_ (error "Unexpected URL: " url)))))
-      (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
-        (mkdir-p my-package)
-        (with-output-to-file (string-append my-package "/opam")
-          (lambda _
-            (format #t "~a" test-opam-file))))
-      (mock ((guix import opam) get-opam-repository
-             (lambda _
-               test-repo))
-        (match (opam->guix-package "foo")
-          (('package
-             ('name "ocaml-foo")
-             ('version "1.0.0")
-             ('source ('origin
-                        ('method 'url-fetch)
-                        ('uri "https://example.org/foo-1.0.0.tar.gz")
-                        ('sha256
-                         ('base32
-                          (? string? hash)))))
-             ('build-system 'ocaml-build-system)
-             ('inputs
-              ('quasiquote
-               (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
-             ('native-inputs
-              ('quasiquote
-               (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
-                ("ocamlbuild" ('unquote 'ocamlbuild)))))
-             ('home-page "https://example.org/")
-             ('synopsis "Some example package")
-             ('description "This package is just an example.")
-             ('license #f))
-           (string=? (bytevector->nix-base32-string
-                      test-source-hash)
-                     hash))
-          (x
-           (pk 'fail x #f))))))
+  (begin
+    (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
+      (mkdir-p my-package)
+      (with-output-to-file (string-append my-package "/opam")
+        (lambda _
+          (format #t "~a" test-opam-file))))
+    (mock
+     ((guix import utils) guix-hash-url
+      (lambda (url)
+        (match url
+          ("https://example.org/foo-1.0.0.tar.gz" %test-hash)
+          (_ (error "Unexpected URL: " url)))))
+     (mock
+      ((guix import opam) get-opam-repository
+       (lambda _
+         test-repo))
+      (match (opam->guix-package "foo")
+        (('package
+           ('name "ocaml-foo")
+           ('version "1.0.0")
+           ('source ('origin
+                      ('method 'url-fetch)
+                      ('uri "https://example.org/foo-1.0.0.tar.gz")
+                      ('sha256
+                       ('base32
+                        (? string? hash)))))
+           ('build-system 'ocaml-build-system)
+           ('inputs
+            ('quasiquote
+             (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+           ('native-inputs
+            ('quasiquote
+             (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+              ("ocamlbuild" ('unquote 'ocamlbuild)))))
+           ('home-page "https://example.org/")
+           ('synopsis "Some example package")
+           ('description "This package is just an example.")
+           ('license #f))
+         (string=? hash %test-hash))
+        (x
+         (pk 'fail x #f)))))))
 
 ;; Test the opam file parser
 ;; We fold over some test cases. Each case is a pair of the string to parse and the
-- 
2.20.1 (Apple Git-117)
?
You may also send email to 36662@debbugs.gnu.org to comment.