>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-search 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 reporting. * 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 © 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Eric Bavier ;;; Copyright © 2019 Arun Isaac +;;; Copyright © 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)) (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"))))) +(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."))) (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"))) +(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 contains +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 for the repository at URL. Return the corresponding JSON dictionaries (alists), @@ -149,12 +201,6 @@ empty list." (github-user-slash-repository url) "/tags")) - (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=" (%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 © 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 (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 (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 github when +;;; possible. + +;;; Code: + +(define (go-name->url name) + "Takes a go-name on the form github.com/andyleap/go-ssb and turns it into +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-org-" (substring name 11))) + ((string-prefix? "cryptoscope.co/go/" name) (string-append "go-cryptoscope-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=package&id=" 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 used 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 fall +;; 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-ssb"))) + +(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 @@ url-fetch guix-hash-url + guix-hash-directory 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))) +(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." -- 2.19.2