From patchwork Sun Sep 1 14:56:02 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 15199 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 BBAB0172FE; Sun, 1 Sep 2019 15:57:20 +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=unavailable 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 2C79E172F0 for ; Sun, 1 Sep 2019 15:57:20 +0100 (BST) Received: from localhost ([::1]:57906 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i4RI7-0006La-ON for patchwork@mira.cbaines.net; Sun, 01 Sep 2019 10:57:19 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43583) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i4RHt-00067w-8d for guix-patches@gnu.org; Sun, 01 Sep 2019 10:57:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i4RHr-0004tx-1N for guix-patches@gnu.org; Sun, 01 Sep 2019 10:57:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48235) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1i4RHq-0004tr-Ur for guix-patches@gnu.org; Sun, 01 Sep 2019 10:57:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1i4RHq-0008Px-TO for guix-patches@gnu.org; Sun, 01 Sep 2019 10:57:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#37254] [PATCH 3/4] import: create: Separate crates.io API from actual conversion. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 01 Sep 2019 14:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37254 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 37254@debbugs.gnu.org Received: via spool by 37254-submit@debbugs.gnu.org id=B37254.156734979932308 (code B ref 37254); Sun, 01 Sep 2019 14:57:02 +0000 Received: (at 37254) by debbugs.gnu.org; 1 Sep 2019 14:56:39 +0000 Received: from localhost ([127.0.0.1]:57052 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i4RHO-0008Ox-Vu for submit@debbugs.gnu.org; Sun, 01 Sep 2019 10:56:38 -0400 Received: from eggs.gnu.org ([209.51.188.92]:34973) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i4RHM-0008OF-7O for 37254@debbugs.gnu.org; Sun, 01 Sep 2019 10:56:32 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:48569) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1i4RHH-0004bc-0O; Sun, 01 Sep 2019 10:56:27 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=40532 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1i4RHF-0002la-Nw; Sun, 01 Sep 2019 10:56:26 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 1 Sep 2019 16:56:02 +0200 Message-Id: <20190901145603.15515-3-ludo@gnu.org> X-Mailer: git-send-email 2.23.0 In-Reply-To: <20190901145603.15515-1-ludo@gnu.org> References: <20190901145603.15515-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] 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: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches This provides a clean separation between bindings to the https://crates.io/api/v1 API and actual conversion to Guix package sexps. As a side-effect, it fixes things like "guix import blake2-rfc", "guix refresh -t crates", etc. * guix/import/crate.scm (, , ): New record types. (lookup-crate, crate-version-dependencies): New procedures. (crate-fetch): Remove. (crate->guix-package): Rewrite to use the new API. (latest-release): Likewise. * guix/build-system/cargo.scm (%crate-base-url): New variable. * tests/crate.scm (test-crate): Update accordingly. --- guix/build-system/cargo.scm | 11 ++- guix/import/crate.scm | 150 ++++++++++++++++++++++++++---------- tests/crate.scm | 13 +++- 3 files changed, 128 insertions(+), 46 deletions(-) diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index 10a1bac844..1e8b3a578e 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2016 David Craven @@ -35,12 +35,17 @@ #:export (%cargo-build-system-modules %cargo-utils-modules cargo-build-system + %crate-base-url crate-url crate-url? crate-uri)) -(define crate-url "https://crates.io/api/v1/crates/") -(define crate-url? (cut string-prefix? crate-url <>)) +(define %crate-base-url + (make-parameter "https://crates.io")) +(define crate-url + (string-append (%crate-base-url) "/api/v1/crates/")) +(define crate-url? + (cut string-prefix? crate-url <>)) (define (crate-uri name version) "Return a URI string for the crate package hosted at crates.io corresponding diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 52c5cb1c30..bcd5068e6c 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 David Craven +;;; Copyright © 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module ((guix download) #:prefix download:) #:use-module (gcrypt hash) #:use-module (guix http-client) + #:use-module (guix json) #:use-module (guix import json) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) @@ -30,7 +32,6 @@ #:use-module (guix upstream) #:use-module (guix utils) #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) ; recursive #:use-module (json) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) @@ -39,46 +40,82 @@ guix-package->crate-name %crate-updater)) -(define (crate-fetch crate-name callback) - "Fetch the metadata for CRATE-NAME from crates.io and call the callback." + +;;; +;;; Interface to https://crates.io/api/v1. +;;; - (define (crates->inputs crates) - (sort (map (cut assoc-ref <> "crate_id") crates) string-ci below. +(define-json-mapping make-crate crate? + json->crate + (name crate-name) ;string + (latest-version crate-latest-version "max_version") ;string + (home-page crate-home-page "homepage") ;string | #nil + (repository crate-repository) ;string + (description crate-description) ;string + (keywords crate-keywords ;list of strings + "keywords" vector->list) + (categories crate-categories ;list of strings + "categories" vector->list) + (versions crate-versions "actual_versions" ;list of + (lambda (vector) + (map json->crate-version + (vector->list vector)))) + (links crate-links)) ;alist - (define (string->license string) - (map spdx-string->license (string-split string #\/))) +;; Crate version. +(define-json-mapping make-crate-version crate-version? + json->crate-version + (id crate-version-id) ;integer + (number crate-version-number "num") ;string + (download-path crate-version-download-path "dl_path") ;string + (readme-path crate-version-readme-path "readme_path") ;string + (license crate-version-license "license") ;string + (links crate-version-links)) ;alist - (define (crate-kind-predicate kind) - (lambda (dep) (string=? (assoc-ref dep "kind") kind))) - - (and-let* ((crate-json (json-fetch (string-append crate-url crate-name))) - (crate (assoc-ref crate-json "crate")) - (name (assoc-ref crate "name")) - (version (assoc-ref crate "max_version")) - (homepage (assoc-ref crate "homepage")) - (repository (assoc-ref crate "repository")) - (synopsis (assoc-ref crate "description")) - (description (assoc-ref crate "description")) - (license (or (and=> (assoc-ref crate "license") - string->license) - '())) ;missing license info - (path (string-append "/" version "/dependencies")) - (deps-json (json-fetch (string-append crate-url name path))) - (deps (vector->list (assoc-ref deps-json "dependencies"))) - (dep-crates (filter (crate-kind-predicate "normal") deps)) - (dev-dep-crates - (filter (lambda (dep) - (not ((crate-kind-predicate "normal") dep))) deps)) - (cargo-inputs (crates->inputs dep-crates)) - (cargo-development-inputs (crates->inputs dev-dep-crates)) - (home-page (match homepage - (() repository) - (_ homepage)))) - (callback #:name name #:version version - #:cargo-inputs cargo-inputs - #:cargo-development-inputs cargo-development-inputs - #:home-page home-page #:synopsis synopsis - #:description description #:license license))) +;; Crate dependency. Each dependency (each edge in the graph) is annotated as +;; being a "normal" dependency or a development dependency. There also +;; information about the minimum required version, such as "^0.0.41". +(define-json-mapping make-crate-dependency + crate-dependency? + json->crate-dependency + (id crate-dependency-id "crate_id") ;string + (kind crate-dependency-kind "kind" ;'normal | 'dev + string->symbol) + (requirement crate-dependency-requirement "req")) ;string + +(define (lookup-crate name) + "Look up NAME on https://crates.io and return the corresopnding +record or #f if it was not found." + (let ((json (json-fetch (string-append (%crate-base-url) "/api/v1/crates/" + name)))) + (and=> (and json (assoc-ref json "crate")) + (lambda (alist) + ;; The "versions" field of ALIST is simply a list of version IDs + ;; (integers). Here, we squeeze in the actual version + ;; dictionaries that are not part of ALIST but are just more + ;; convenient handled this way. + (let ((versions (or (assoc-ref json "versions") '#()))) + (json->crate `(,@alist + ("actual_versions" . ,versions)))))))) + +(define (crate-version-dependencies version) + "Return the list of records of VERSION, a +." + (let* ((path (assoc-ref (crate-version-links version) "dependencies")) + (url (string-append (%crate-base-url) path))) + (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) + (map json->crate-dependency (vector->list vector))) + (_ + '())))) + + +;;; +;;; Converting crates to Guix packages. +;;; (define (maybe-cargo-inputs package-names) (match (package-names->package-inputs package-names) @@ -141,7 +178,35 @@ and LICENSE." (define (crate->guix-package crate-name) "Fetch the metadata for CRATE-NAME from crates.io, and return the `package' s-expression corresponding to that package, or #f on failure." - (crate-fetch crate-name make-crate-sexp)) + (define (string->license string) + (map spdx-string->license (string-split string #\/))) + + (define (normal-dependency? dependency) + (eq? (crate-dependency-kind dependency) 'normal)) + + (let* ((crate (lookup-crate crate-name)) + (version (find (lambda (version) + (string=? (crate-version-number version) + (crate-latest-version crate))) + (crate-versions crate))) + (dependencies (crate-version-dependencies version)) + (dep-crates (filter normal-dependency? dependencies)) + (dev-dep-crates (remove normal-dependency? dependencies)) + (cargo-inputs (sort (map crate-dependency-id dep-crates) + string-ci (crate-version-license version) + string->license)))) (define (guix-package->crate-name package) "Return the crate name of PACKAGE." @@ -157,6 +222,7 @@ and LICENSE." (define (crate-name->package-name name) (string-append "rust-" (string-join (string-split name #\_) "-"))) + ;;; ;;; Updater ;;; @@ -175,9 +241,9 @@ and LICENSE." (define (latest-release package) "Return an for the latest release of PACKAGE." (let* ((crate-name (guix-package->crate-name package)) - (callback (lambda* (#:key version #:allow-other-keys) version)) - (version (crate-fetch crate-name callback)) - (url (crate-uri crate-name version))) + (crate (lookup-crate crate-name)) + (version (crate-latest-version crate)) + (url (crate-uri crate-name version))) (upstream-source (package (package-name package)) (version version) diff --git a/tests/crate.scm b/tests/crate.scm index 72c3a13350..8a232ba06c 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 David Craven +;;; Copyright © 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,10 +33,20 @@ \"crate\": { \"max_version\": \"1.0.0\", \"name\": \"foo\", - \"license\": \"MIT/Apache-2.0\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"foo\", + \"num\": \"1.0.0\", + \"license\": \"MIT/Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\" + } + } + ] } }")