From mboxrd@z Thu Jan 1 00:00:00 1970 From: swedebugia Subject: Re: Go importer - help with git-fetch Date: Tue, 6 Aug 2019 22:26:46 +0200 Message-ID: <7ff3ff2d-0e35-8b57-8b0c-28e0ccfda326@riseup.net> References: <4c2f5f76-b431-57ce-3697-ac2cbb48f395@riseup.net> <87zhkmxxjl.fsf@elephly.net> <8736iezbr1.fsf@sdf.lonestar.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------D396727606832CFFBC730CBC" Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:34668) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hv62p-0005RH-1U for guix-devel@gnu.org; Tue, 06 Aug 2019 16:26:57 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hv62m-0000Io-Np for guix-devel@gnu.org; Tue, 06 Aug 2019 16:26:54 -0400 Received: from mx1.riseup.net ([198.252.153.129]:34970) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hv62m-0000IR-8n for guix-devel@gnu.org; Tue, 06 Aug 2019 16:26:52 -0400 In-Reply-To: <8736iezbr1.fsf@sdf.lonestar.org> Content-Language: en-US List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: "Jakob L. Kreuze" Cc: guix-devel@gnu.org This is a multi-part message in MIME format. --------------D396727606832CFFBC730CBC Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Hi :) Thanks for the quick responses. On 2019-08-06 15:04, Jakob L. Kreuze wrote: > Ricardo Wurmus writes: > > ... > Yes -- my apologies, I probably should have clarified in the earlier > email thread. 'git-fetch' from (guix git-download) needs to be run in > the store monad, but 'git-fetch' from (guix build git) doesn't. You can > get rid of 'with-store' and 'run-with-store'. Done! (see attached) I got the git-fetch and hashing to work. :D Next challenge: silence git-fetch. Do any of you know how to do that? I imagine it entails sending its text output to some dummy port. -- Cheers Swedebugia --------------D396727606832CFFBC730CBC Content-Type: text/x-patch; name="0001-guix-import-Add-golang-importer-utilizing-the-Go-sea.patch" Content-Disposition: attachment; filename*0="0001-guix-import-Add-golang-importer-utilizing-the-Go-sea.pa"; filename*1="tch" Content-Transfer-Encoding: quoted-printable >From f01dff653c365fb15acdac165a3ad0cf2f809930 Mon Sep 17 00:00:00 2001 From: swedebugia Date: Tue, 6 Aug 2019 22:20:10 +0200 Subject: [PATCH] guix: import: Add golang importer utilizing the Go-searc= h API. * guix/import/github.scm (fetch-readme, fetch-license) (fetch-latest-commit, headers, http-url?): Add support for /commits, /license, and /readme Github APIv3 endpoints. (export): Export fetch-readme, fetch-license & fetch-latest-commit. (github-user-slash-repository): Use http-url? for better error reportin= g. * guix/import/go.scm: New file. * guix/import/utils.scm (guix-hash-directory): New procedure. (export): Export it. --- guix/import/github.scm | 66 ++++++++++-- guix/import/go.scm | 232 +++++++++++++++++++++++++++++++++++++++++ guix/import/utils.scm | 5 + 3 files changed, 293 insertions(+), 10 deletions(-) create mode 100644 guix/import/go.scm diff --git a/guix/import/github.scm b/guix/import/github.scm index fa23fa4c0..b889da69a 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -3,6 +3,7 @@ ;;; Copyright =C2=A9 2017, 2018, 2019 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2018 Eric Bavier ;;; Copyright =C2=A9 2019 Arun Isaac +;;; Copyright =C2=A9 2019 swedebugia ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,11 @@ #:use-module (guix upstream) #:use-module (guix http-client) #:use-module (web uri) - #:export (%github-updater)) + #:export (%github-updater + fetch-latest-commit + fetch-license + latest-released-version + fetch-readme)) =20 (define (find-extension url) "Return the extension of the archive e.g. '.tar.gz' given a URL, or @@ -115,19 +120,66 @@ URL of the form 'https://github.com/arq5x/bedtools2= /archive/v2.24.0.tar.gz'" ((_ owner project . rest) (string-append (basename project ".git"))))) =20 +(define (http-url? url) + ;; We only support Github urls beginning with http. + (string-prefix? "http" url)) + (define (github-user-slash-repository url) "Return a string e.g. arq5x/bedtools2 of the owner and the name of the repository separated by a forward slash, from a string URL of the form 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" - (match (string-split (uri-path (string->uri url)) #\/) - ((_ owner project . rest) - (string-append owner "/" (basename project ".git"))))) + (if (http-url? url) + (match (string-split (uri-path (string->uri url)) #\/) + ((_ owner project . rest) + (string-append owner "/" (basename project ".git")))) + (error "Not a valid url."))) =20 (define %github-token ;; Token to be passed to Github.com to avoid the 60-request per hour ;; limit, or #f. (make-parameter (getenv "GUIX_GITHUB_TOKEN"))) =20 +(define headers + ;; Ask for version 3 of the API as suggested at + ;; . + `((Accept . "application/vnd.github.v3+json") + (user-agent . "GNU Guile"))) + +(define (fetch-readme url) + "Return a file with the README if any from a github repository url." + (let ((readme-url + (string-append "https://api.github.com/repos/" + (github-user-slash-repository url) + "/readme"))) + "Get json, extract and fetch the raw url." + (let ((data (json-fetch readme-url #:headers headers))) + (http-fetch (assoc-ref data "download_url"))))) + +(define (fetch-license url) + "Return the license json if any from a github repository url. This con= tains +the SPDX id among other things." + (let ((license-url + (string-append "https://api.github.com/repos/" + (github-user-slash-repository url) + "/license"))) + (json-fetch license-url #:headers headers))) + +(define (fetch-latest-commit url) + "Get the latest commit-id." + (let ((commit-url + (string-append "https://api.github.com/repos/" + (github-user-slash-repository url) + "/commits"))) + ;; This might be able to implement using only match + (assoc-ref + (match (vector->list (json-fetch commit-url)) + (() ;empty + (error "No commits")) + ;; Pick the latest one + (((_ . x) . _) x) + ) + "sha"))) + (define (fetch-releases-or-tags url) "Fetch the list of \"releases\" or, if it's empty, the list of tags fo= r the repository at URL. Return the corresponding JSON dictionaries (alists), @@ -149,12 +201,6 @@ empty list." (github-user-slash-repository url) "/tags")) =20 - (define headers - ;; Ask for version 3 of the API as suggested at - ;; . - `((Accept . "application/vnd.github.v3+json") - (user-agent . "GNU Guile"))) - (define (decorate url) (if (%github-token) (string-append url "?access_token=3D" (%github-token)) diff --git a/guix/import/go.scm b/guix/import/go.scm new file mode 100644 index 000000000..77711fb49 --- /dev/null +++ b/guix/import/go.scm @@ -0,0 +1,232 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2019 swedebugia +;;; +;;; 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 (a= t +;;; 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 (guix import go) + #:use-module (ice-9 match) + #:use-module (ice-9 textual-ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) ;and-let + #:use-module (guix utils) + #:use-module (guix build git) + #:use-module (guix import github) + #:use-module (guix import json) + #:use-module (guix import utils) + #:use-module (guix packages) + #:use-module (web uri)) + +;;; Commentary: +;;; This utilizes the https://go-search.org/infoapi API. +;;; This API contains no licenses or versions. We fetch those from githu= b when +;;; possible. + +;;; Code: + +(define (go-name->url name) + "Takes a go-name on the form github.com/andyleap/go-ssb and turns it i= nto +https://github.com/andyleap/go-ssb" + (string-append "https://" name)) + +;; from opam.scm - should probably be factored out to utils.scm +(define (substitute-char str what with) + (string-join (string-split str what) with)) + +(define (go-name->guix-name name) + "Takes a go-name e.g. on the form github.com/x/y and turns it into +go-github-com-x-y" + (substitute-char + (substitute-char + (cond + ;;((equal? name "ocamlfind") "ocaml-findlib") + ;;((string-prefix? "ocaml" name) name) + ((string-prefix? "github.com/" name) (string-append "go-github-com-= " (substring name 11))) + ((string-prefix? "golang.org/x/" name) (string-append "go-golang-or= g-" (substring name 11))) + ((string-prefix? "cryptoscope.co/go/" name) (string-append "go-cryp= toscope-co-" (substring name 11))) + (else (string-append "go-" name))) + #\_ "-") + #\/ "-")) +;;(display (go-name->guix-name "golang.org/x/text/transform")) + +(define (fetch-data name) + "Fetches data about imports and description" + (json-fetch (string-append "https://go-search.org/api" + "?action=3Dpackage&id=3D" name))) +;;(display (hash-table->alist (fetch-data "golang.org/x/text/transform")= )) + +(define (synopsis name) + (and-let* ((data (fetch-data name))) + (if (assoc-ref data "Synopsis") + (assoc-ref data "Synopsis") + ;; If synopsis is empty get the description instead + (assoc-ref data "Description")))) + +;;(display (synopsis "golang.org/x/text/transform")) + +;; Github projects enable us to get the license and readme +(define (github-url? url) + (->bool (string-prefix? "https://github.com/" url))) + +(define (string->license name) + "Get SPDX-id from github if github-url" + (and-let* ((url (go-name->url name)) + (github-url? url) + (data (fetch-license url)) + (hasht (assoc-ref data "license")) + (str (string-downcase (assoc-ref hasht "spdx_id")))) + (cond + ((equal? str "gpl-3.0") '(license:gpl-3)) + (else `(,string-append "license:" ,str))))) + +;;(display (string->license "github.com/andyleap/go-ssb")) + +(define (readme name) + "We get the first 1000 characters for the description" + (and-let* ((url (go-name->url name)) + (github-url? url)) + (get-string-n (fetch-readme url) 1000))) + +(define (description name) + (and-let* ((data (fetch-data name))) + (if (assoc-ref data "Synopsis") + ;; Synopsis is non-empty. + (if (assoc-ref data "Description") + (assoc-ref data "Description") + ;; Description is empty + (readme name)) + ;; Synopsis is empty and the description from GSAPI has been use= d as + ;; synopsis, get the readme instead + (readme name)))) + +;;(display (description "golang.org/x/text/transform")) + +;; Versions are tricky because the go-ecosystem does not rely on them at +;; all. We get the latest released or tagged version from github and fal= l +;; backto the latest commit. +(define (version name) + "Get the latest release or tag if any." + (and-let* ((url (go-name->url name)) + (github-url? url)) + (latest-released-version url name))) + +;;(display (version "github.com/andyleap/go-ssb")) + +(define (commit name) + "Get latest commit-id" + (and-let* ((url (go-name->url name)) + (github-url? url)) + (fetch-latest-commit url))) + +;;(display (commit "github.com/andyleap/go-ssb")) + +(define (dependencies name) + (and-let* ((data (fetch-data name))) + ;; Join with (assoc-ref data "TestImports")? + (assoc-ref data "Imports"))) + +;;(display (dependencies "golang.org/x/text/transform")) + +(define (test-dependencies name) + (and-let* ((data (fetch-data name))) + ;; Join with (assoc-ref data "TestImports")? + (assoc-ref data "TestImports"))) + +;; this is from ocaml.scm +(define (dependencies->inputs dependencies) + "Transform the list of dependencies in a list of inputs." + (if (not dependencies) + '() + (map (lambda (input) + (list input (list 'unquote (string->symbol input)))) + (map go-name->guix-name dependencies)))) + +;;(display (dependencies->inputs (dependencies "github.com/andyleap/go-s= sb"))) + +(define (go->guix-package name) + (let ((version (version name))) + (if (equal? version #t) + ;; Got release or tag + (let ((source-url (go-name->url name)) + (commit version) + (inputs (dependencies->inputs (dependencies name))) + (synopsis (synopsis name)) + (description (description name))) + ;; This is broken because of git-fetch from git-download does = not at + ;; all work like the similar url-fetch-procedure. + (call-with-temporary-directory + (lambda (temp) + (and (git-fetch source-url commit temp) + `(package + (name ,(go-name->guix-name name)) + (version ,version) + (source + (origin + (method git-fetch) + (uri (git-reference + (url ,source-url) + (commit ,commit))) + (file-name (git-file-name name version)) + (sha256 (base32 ,(guix-hash-directory temp))))) + (build-system go-build-system) + ,@(if (null? inputs) + '() + `((inputs ,(list 'quasiquote inputs)))) + (home-page ,source-url) + (synopsis ,synopsis) + (description ,description) + (license ,@(string->license name))))))) + ;; No release or tag, fall back to latest commit + (let ((source-url (go-name->url name)) + (commit (commit name)) + (inputs (dependencies->inputs (dependencies name))) + (synopsis (synopsis name)) + (description (description name))) + (call-with-temporary-directory + (lambda (temp) + (and (git-fetch source-url commit temp) + `(package + (name ,(go-name->guix-name name)) + (version ,version) + (source + (origin + (method git-fetch) + (uri (git-reference + (url ,source-url) + (commit ,commit))) + (file-name (git-file-name name version)) + (sha256 (base32 ,(guix-hash-directory temp))))) + (build-system go-build-system) + ,@(if (null? inputs) + '() + `((inputs ,(list 'quasiquote inputs)))) + (home-page ,source-url) + (synopsis ,synopsis) + (description ,description) + (license ,@(string->license name)))))))))) +#; +(go->guix-package "github.com/gogo/protobuf") + +;; Debug +#; +(display + (call-with-temporary-directory + (lambda (temp) + (let* ((name "github.com/gogo/protobuf") + (url (go-name->url name)) + (commit "28a6bbf47e48e0b2220b2a244750b660c83d4942")) + (let ((path (string-append "/tmp" name))) + (git-fetch url commit temp) + (guix-hash . ("-r" "-x" temp))))))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 2a3b7341f..23948e402 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -34,6 +34,7 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix download) + #:use-module (guix scripts hash) #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -50,6 +51,7 @@ =20 url-fetch guix-hash-url + guix-hash-directory =20 package-names->package-inputs maybe-inputs @@ -125,6 +127,9 @@ recursively apply the procedure to the sub-list." "Return the hash of FILENAME in nix-base32 format." (bytevector->nix-base32-string (file-sha256 filename))) =20 +(define (guix-hash-directory dir) + (guix-hash . ("-r" "-x" dir))) + (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." --=20 2.19.2 --------------D396727606832CFFBC730CBC--