Re: Go importer - help with git-fetch

[swedebugia <swedebugia@riseup.net>]

[-- Attachment #1: Type: text/plain, Size: 630 bytes --]

Hi :)

Thanks for the quick responses.

On 2019-08-06 15:04, Jakob L. Kreuze wrote:
> Ricardo Wurmus <rekado@elephly.net> 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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-import-Add-golang-importer-utilizing-the-Go-sea.patch --]
[-- Type: text/x-patch; name="0001-guix-import-Add-golang-importer-utilizing-the-Go-sea.patch", Size: 15621 bytes --]

From f01dff653c365fb15acdac165a3ad0cf2f809930 Mon Sep 17 00:00:00 2001
From: swedebugia <swedebugia@riseup.net>
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 <ludo@gnu.org>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2019 swedebugia <swedebugia@riseup.net>
 ;;;
 ;;; 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
+    ;; <https://developer.github.com/v3/>.
+    `((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
-    ;; <https://developer.github.com/v3/>.
-    `((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 <swedebugia@riseup.net>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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