From patchwork Sat Jun 1 22:36:36 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Robert Vollmert X-Patchwork-Id: 14197 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id DE1DF1707B; Sat, 1 Jun 2019 23:37:09 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 80F7D17074 for ; Sat, 1 Jun 2019 23:37:08 +0100 (BST) Received: from localhost ([127.0.0.1]:42141 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hXCcd-0006sJ-3k for patchwork@mira.cbaines.net; Sat, 01 Jun 2019 18:37:07 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47980) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hXCca-0006sC-KA for guix-patches@gnu.org; Sat, 01 Jun 2019 18:37:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hXCcY-0004ZH-Rk for guix-patches@gnu.org; Sat, 01 Jun 2019 18:37:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:53635) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hXCcY-0004ZD-Ou for guix-patches@gnu.org; Sat, 01 Jun 2019 18:37:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hXCcY-00040I-M2 for guix-patches@gnu.org; Sat, 01 Jun 2019 18:37:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#36048] [PATCH] guix: import: hackage: handle hackage revisions Resent-From: Robert Vollmert Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 01 Jun 2019 22:37:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 36048 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 36048@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.155942862115382 (code B ref -1); Sat, 01 Jun 2019 22:37:02 +0000 Received: (at submit) by debbugs.gnu.org; 1 Jun 2019 22:37:01 +0000 Received: from localhost ([127.0.0.1]:38946 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hXCcX-000401-5G for submit@debbugs.gnu.org; Sat, 01 Jun 2019 18:37:01 -0400 Received: from eggs.gnu.org ([209.51.188.92]:33566) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hXCcU-0003zo-Do for submit@debbugs.gnu.org; Sat, 01 Jun 2019 18:36:59 -0400 Received: from lists.gnu.org ([209.51.188.17]:39389) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hXCcP-0004VH-7I for submit@debbugs.gnu.org; Sat, 01 Jun 2019 18:36:53 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47948) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hXCcN-0006rq-C4 for guix-patches@gnu.org; Sat, 01 Jun 2019 18:36:53 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hXCcL-0004Th-Kv for guix-patches@gnu.org; Sat, 01 Jun 2019 18:36:51 -0400 Received: from mx1.mailbox.org ([80.241.60.212]:27650) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hXCcL-0004SJ-C6 for guix-patches@gnu.org; Sat, 01 Jun 2019 18:36:49 -0400 Received: from smtp1.mailbox.org (smtp1.mailbox.org [IPv6:2001:67c:2050:105:465:1:1:0]) (using TLSv1.2 with cipher ECDHE-RSA-CHACHA20-POLY1305 (256/256 bits)) (No client certificate requested) by mx1.mailbox.org (Postfix) with ESMTPS id 368E34E8DD; Sun, 2 Jun 2019 00:36:46 +0200 (CEST) X-Virus-Scanned: amavisd-new at heinlein-support.de Received: from smtp1.mailbox.org ([80.241.60.240]) by spamfilter01.heinlein-hosting.de (spamfilter01.heinlein-hosting.de [80.241.56.115]) (amavisd-new, port 10030) with ESMTP id c-kscZiOC9pD; Sun, 2 Jun 2019 00:36:37 +0200 (CEST) From: Robert Vollmert Date: Sun, 2 Jun 2019 00:36:36 +0200 Message-Id: <20190601223636.74362-1-rob@vllmrt.net> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Robert Vollmert Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hackage packages can have metadata revision (cabal-file only) that aren't reflected in the source archive. haskell-build-system has support for this, but previously `guix import hackage` would create a definition based on the new cabal file but building using the old cabal file. Compare https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35750. * guix/import/cabal.scm: Parse `x-revision:` property. * guix/import/hackage.scm: Compute hash of cabal file, and write cabal-revision build system arguments. * guix/tests/hackage.scm: Test import of cabal revision. --- guix/import/cabal.scm | 7 +++-- guix/import/hackage.scm | 61 ++++++++++++++++++++++++++++++----------- tests/hackage.scm | 46 +++++++++++++++++++++++++++++++ 3 files changed, 96 insertions(+), 18 deletions(-) diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm index 1a87be0b00..7dfe771e41 100644 --- a/guix/import/cabal.scm +++ b/guix/import/cabal.scm @@ -40,6 +40,7 @@ cabal-package? cabal-package-name cabal-package-version + cabal-package-revision cabal-package-license cabal-package-home-page cabal-package-source-repository @@ -638,13 +639,14 @@ If #f use the function 'port-filename' to obtain it." ;; information of the Cabal file, but only the ones we currently are ;; interested in. (define-record-type - (make-cabal-package name version license home-page source-repository + (make-cabal-package name version revision license home-page source-repository synopsis description executables lib test-suites flags eval-environment custom-setup) cabal-package? (name cabal-package-name) (version cabal-package-version) + (revision cabal-package-revision) (license cabal-package-license) (home-page cabal-package-home-page) (source-repository cabal-package-source-repository) @@ -838,6 +840,7 @@ See the manual for limitations."))))))) (define (cabal-evaluated-sexp->package evaluated-sexp) (let* ((name (lookup-join evaluated-sexp "name")) (version (lookup-join evaluated-sexp "version")) + (revision (lookup-join evaluated-sexp "x-revision")) (license (lookup-join evaluated-sexp "license")) (home-page (lookup-join evaluated-sexp "homepage")) (home-page-or-hackage @@ -856,7 +859,7 @@ See the manual for limitations."))))))) (custom-setup (match (make-cabal-section evaluated-sexp 'custom-setup) ((x) x) (_ #f)))) - (make-cabal-package name version license home-page-or-hackage + (make-cabal-package name version revision license home-page-or-hackage source-repository synopsis description executables lib test-suites flags eval-environment custom-setup))) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 366256b40d..cf8219143a 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -117,9 +117,15 @@ version is returned." (#f name) (m (match:substring m 1))))))) -(define (hackage-fetch name-version) - "Return the Cabal file for the package NAME-VERSION, or #f on failure. If -the version part is omitted from the package name, then return the latest +(define (read-cabal-and-hash port) + (let-values (((port get-hash) (open-sha256-input-port port))) + (cons + (read-cabal (canonical-newline-port port)) + (bytevector->nix-base32-string (get-hash))))) + +(define (hackage-fetch-and-hash name-version) + "Return the Cabal file and hash for the package NAME-VERSION, or #f on failure. +If the version part is omitted from the package name, then return the latest version." (guard (c ((and (http-get-error? c) (= 404 (http-get-error-code c))) @@ -127,10 +133,18 @@ version." (let-values (((name version) (package-name->name+version name-version))) (let* ((url (hackage-cabal-url name version)) (port (http-fetch url)) - (result (read-cabal (canonical-newline-port port)))) + (result (read-cabal-and-hash port))) (close-port port) result)))) +(define (hackage-fetch name-version) + "Return the Cabal file for the package NAME-VERSION, or #f on failure. If +the version part is omitted from the package name, then return the latest +version." + (match (hackage-fetch-and-hash name-version) + ((cabal . hash) cabal) + (_ #f))) + (define string->license ;; List of valid values from ;; https://www.haskell.org @@ -198,15 +212,19 @@ package being processed and is used to filter references to itself." (cons own-name ghc-standard-libraries)))) dependencies)) -(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) +(define* (hackage-module->sexp cabal cabal-hash #:key (include-test-dependencies? #t)) "Return the `package' S-expression for a Cabal package. CABAL is the -representation of a Cabal file as produced by 'read-cabal'." +representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is +the hash of the Cabal file." (define name (cabal-package-name cabal)) (define version (cabal-package-version cabal)) + + (define revision + (cabal-package-revision cabal)) (define source-url (hackage-source-url name version)) @@ -252,9 +270,17 @@ representation of a Cabal file as produced by 'read-cabal'." (list 'quasiquote inputs)))))) (define (maybe-arguments) - (if (not include-test-dependencies?) - '((arguments `(#:tests? #f))) - '())) + (define testargs (if (not include-test-dependencies?) + '(#:tests? #f) + '())) + (define revargs (if (not (string-null? revision)) + `(#:cabal-revision (,revision ,cabal-hash)) + '())) + (define args (append testargs revargs)) + (if (not (nil? args)) + (let ((qargs `(,'quasiquote ,args))) + `((arguments ,qargs))) + '())) (let ((tarball (with-store store (download-to-store store source-url)))) @@ -294,13 +320,16 @@ symbol 'true' or 'false'. The value associated with other keys has to conform to the Cabal file format definition. The default value associated with the keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" respectively." - (let ((cabal-meta (if port - (read-cabal (canonical-newline-port port)) - (hackage-fetch package-name)))) - (and=> cabal-meta (compose (cut hackage-module->sexp <> - #:include-test-dependencies? - include-test-dependencies?) - (cut eval-cabal <> cabal-environment))))) + (match + (if port (read-cabal-and-hash port) + (hackage-fetch-and-hash package-name)) + ((cabal-meta . cabal-hash) + (and=> cabal-meta (compose (cut hackage-module->sexp <> + cabal-hash + #:include-test-dependencies? + include-test-dependencies?) + (cut eval-cabal <> cabal-environment)))) + (_ #f))) (define hackage->guix-package/m ;memoized variant (memoize hackage->guix-package)) diff --git a/tests/hackage.scm b/tests/hackage.scm index 38a5825af7..fe4e0efb69 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -274,6 +274,52 @@ executable cabal (test-assert "hackage->guix-package test multiline desc (braced)" (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo)) +;; test hackage cabal revisions +(define test-cabal-revision + "name: foo +version: 1.0.0 +x-revision: 2 +homepage: http://test.org +synopsis: synopsis +description: description +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +(define-package-matcher match-ghc-foo-revision + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-http" ('unquote 'ghc-http))))) + ('arguments + ('quasiquote + ('#:cabal-revision + ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng")))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + +(test-assert "hackage->guix-package test cabal revision" + (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision)) + + (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me"))