unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Go importer - help with git-fetch
@ 2019-08-06 10:23 swedebugia
  2019-08-06 10:26 ` Pierre Neidhardt
  2019-08-06 12:56 ` Ricardo Wurmus
  0 siblings, 2 replies; 8+ messages in thread
From: swedebugia @ 2019-08-06 10:23 UTC (permalink / raw)
  To: guix-devel


[-- Attachment #1.1: Type: text/plain, Size: 2595 bytes --]

Hi :)

I'm stuck trying to write a git-fetch -> hash procedure for the go importer.

This is what I am trying to do in pseudocode:

(base32-nix-hash (sha256 (git-fetch url commit temp-path)))

I got this far by using (guix build git):

(display (let* ((name "github.com/gogo/protobuf")
                 (url (go-name->url name))
                 (commit "28a6bbf47e48e0b2220b2a244750b660c83d4942"))
            (with-store store
              (run-with-store store
                (let ((path "test"))
                  (git-fetch url commit path))))))

But I'm pretty new to this derivation 2nd order code stuff and I don't 
understand the errors.

It gives me:

Initialized empty Git repository in /home/egil/src/guix/test2/.git/
remote: Enumerating objects: 924, done.
remote: Counting objects: 100% (924/924), done.
remote: Compressing objects: 100% (745/745), done.
remote: Total 924 (delta 476), reused 330 (delta 132), pack-reused 0
Receiving objects: 100% (924/924), 1.45 MiB | 944.00 KiB/s, done.
Resolving deltas: 100% (476/476), done.
 From https://github.com/gogo/protobuf
  * branch            28a6bbf47e48e0b2220b2a244750b660c83d4942 -> FETCH_HEAD
Note: checking out 'FETCH_HEAD'.

You are in 'detached HEAD' state. You can look around, make experimental
changes and commit them, and you can discard any commits you make in this
state without impacting any branches by performing another checkout.

If you want to create a new branch to retain commits you create, you may
do so (now or later) by using -b with the checkout command again. Example:

   git checkout -b <new-branch-name>

HEAD is now at 28a6bbf [merge] Fix merge of non-nullable slices (#569)
Backtrace:
            8 (apply-smob/1 #<catch-closure 1f4e1c0>)
In ice-9/boot-9.scm:
     705:2  7 (call-with-prompt _ _ #<procedure default-prompt-handle…>)
In ice-9/eval.scm:
     619:8  6 (_ #(#(#<directory (guile-user) 1fe0140>)))
In ice-9/boot-9.scm:
    2312:4  5 (save-module-excursion _)
   3831:12  4 (_)
In guix/import/go.scm:
    262:11  3 (_)
In guix/store.scm:
    623:10  2 (call-with-store #<procedure 2607960 at guix/import/go.…>)
   1803:24  1 (run-with-store #<store-connection 256.99 29f4ae0> _ # _ …)
In unknown file:
            0 (_ #<store-connection 256.99 29f4ae0>)

ERROR: Wrong type to apply: #t

What does this error mean?

I looked into derivations.scm and found out about a port-sha256 from 
gcrypt - is that usable here to compute the hash?

How do I get it to download to a temporary path?

-- 
Cheers Swedebugia

[-- Attachment #1.2: Type: text/html, Size: 3796 bytes --]

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

From b7e99f057039e01a327c2f620b7202f7bc762d6c Mon Sep 17 00:00:00 2001
From: swedebugia <swedebugia@riseup.net>
Date: Thu, 1 Aug 2019 18:54:11 +0200
Subject: [PATCH] guix: import: Add golang importer via 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/github.scm |  66 +++++++++--
 guix/import/go.scm     | 255 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 311 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..4f1aee26d
--- /dev/null
+++ b/guix/import/go.scm
@@ -0,0 +1,255 @@
+;;; 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 hash-table)
+  #: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 git-download) #:prefix download:)
+  #:use-module (guix import github)
+  #:use-module (guix import json)
+  #:use-module (guix import utils)
+  #:use-module (guix packages)
+  #:use-module (guix http-client)
+  #: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-output-file
+           (lambda (temp port)
+             (and (download:git-fetch (download:git-reference
+                                       (url source-url)
+                                       (commit commit))
+                                      "sha256" "dummy-hash")
+                  `(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-url 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)))
+          ;; This is broken because of git-fetch from git-download does not at
+          ;; all work like the similar url-fetch-procedure.
+          (call-with-temporary-output-file
+           (lambda (temp port)
+             (and (download:git-fetch (download:git-reference
+                                       (url source-url)
+                                       (commit commit))
+                                      "sha256" "dummy-hash")
+                  `(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-url 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 (let* ((name "github.com/gogo/protobuf")
+               (url (go-name->url name))
+               (commit name))
+           (call-with-temporary-output-file
+           (lambda (temp port)
+             (download:git-fetch (download:git-reference
+                                  (url url)
+                                  (commit commit))
+                                 "sha256" commit temp)))))
+
+
+#;
+(display (let* ((name "github.com/gogo/protobuf")
+               (url (go-name->url name))
+               (commit name))
+           (download:git-fetch (download:git-reference
+                                (url url)
+                                (commit commit))
+"sha256" commit name)))
+
+;; Both of these returns procedures like this:#<procedure 1b72f50 at guix/git-download.scm:145:2 (state)>
+;; How do we get it to return something we can compute the hash from?
-- 
2.19.2


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 10:23 Go importer - help with git-fetch swedebugia
@ 2019-08-06 10:26 ` Pierre Neidhardt
  2019-08-06 12:45   ` swedebugia
  2019-08-06 12:56 ` Ricardo Wurmus
  1 sibling, 1 reply; 8+ messages in thread
From: Pierre Neidhardt @ 2019-08-06 10:26 UTC (permalink / raw)
  To: swedebugia, guix-devel

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

Just to be sure: did you write the go imported from scratch?  Because a
work-in-progress has been available for a while, you may want to base
your work on it.

-- 
Pierre Neidhardt
https://ambrevar.xyz/

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 10:26 ` Pierre Neidhardt
@ 2019-08-06 12:45   ` swedebugia
  0 siblings, 0 replies; 8+ messages in thread
From: swedebugia @ 2019-08-06 12:45 UTC (permalink / raw)
  To: Pierre Neidhardt, guix-devel

On 2019-08-06 12:26, Pierre Neidhardt wrote:
> Just to be sure: did you write the go imported from scratch?  Because a
> work-in-progress has been available for a while, you may want to base
> your work on it.

Oh. Yeah, I did based on Go-Search and with inspiration from Jakob Kreuze.

I just found the WIP golang.scm among the patches, see #35627. It relies 
on unstable github tarballs for sha256 hashes which in my view is not a 
viable approach. Also it was lacking an easy road to recursive import 
which is really what we want IMHO.

My patch is quite concise in comparison and also extract licenses and 
readme's from github. It also has a complete list of the dependencies 
and can be easily extended with recourse-ability.

Only the hashing is missing now, besides the calling script in 
guix/scripts/import and documentation.

Anyone know how to calculate the hash based on a checkout?

-- 
Cheers Swedebugia

^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 10:23 Go importer - help with git-fetch swedebugia
  2019-08-06 10:26 ` Pierre Neidhardt
@ 2019-08-06 12:56 ` Ricardo Wurmus
  2019-08-06 13:04   ` Jakob L. Kreuze
  1 sibling, 1 reply; 8+ messages in thread
From: Ricardo Wurmus @ 2019-08-06 12:56 UTC (permalink / raw)
  To: swedebugia; +Cc: guix-devel


swedebugia <swedebugia@riseup.net> writes:

> I got this far by using (guix build git):
>
> (display (let* ((name "github.com/gogo/protobuf")
>                  (url (go-name->url name))
>                  (commit "28a6bbf47e48e0b2220b2a244750b660c83d4942"))
>             (with-store store
>               (run-with-store store
>                 (let ((path "test"))
>                   (git-fetch url commit path))))))
>
> But I'm pretty new to this derivation 2nd order code stuff and I don't 
> understand the errors.
>
> It gives me:
>
> Initialized empty Git repository in /home/egil/src/guix/test2/.git/
> remote: Enumerating objects: 924, done.
> remote: Counting objects: 100% (924/924), done.
> remote: Compressing objects: 100% (745/745), done.
> remote: Total 924 (delta 476), reused 330 (delta 132), pack-reused 0
> Receiving objects: 100% (924/924), 1.45 MiB | 944.00 KiB/s, done.
> Resolving deltas: 100% (476/476), done.
>  From https://github.com/gogo/protobuf
>   * branch            28a6bbf47e48e0b2220b2a244750b660c83d4942 -> FETCH_HEAD
> Note: checking out 'FETCH_HEAD'.
>
> You are in 'detached HEAD' state. You can look around, make experimental
> changes and commit them, and you can discard any commits you make in this
> state without impacting any branches by performing another checkout.
>
> If you want to create a new branch to retain commits you create, you may
> do so (now or later) by using -b with the checkout command again. Example:
>
>    git checkout -b <new-branch-name>
>
> HEAD is now at 28a6bbf [merge] Fix merge of non-nullable slices (#569)
> Backtrace:
>             8 (apply-smob/1 #<catch-closure 1f4e1c0>)
> In ice-9/boot-9.scm:
>      705:2  7 (call-with-prompt _ _ #<procedure default-prompt-handle…>)
> In ice-9/eval.scm:
>      619:8  6 (_ #(#(#<directory (guile-user) 1fe0140>)))
> In ice-9/boot-9.scm:
>     2312:4  5 (save-module-excursion _)
>    3831:12  4 (_)
> In guix/import/go.scm:
>     262:11  3 (_)
> In guix/store.scm:
>     623:10  2 (call-with-store #<procedure 2607960 at guix/import/go.…>)
>    1803:24  1 (run-with-store #<store-connection 256.99 29f4ae0> _ # _ …)
> In unknown file:
>             0 (_ #<store-connection 256.99 29f4ae0>)
>
> ERROR: Wrong type to apply: #t
>
> What does this error mean?

The error means that you tried to use #T as a procedure.
“run-with-store” expects a monadic value.  “git-fetch” returns #T,
though, not a monadic value.

Note that we already have all the stuff that’s needed for hash
computation of git checkouts.   Look for “guix hash -rx”.

-- 
Ricardo

^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 12:56 ` Ricardo Wurmus
@ 2019-08-06 13:04   ` Jakob L. Kreuze
  2019-08-06 20:26     ` swedebugia
  0 siblings, 1 reply; 8+ messages in thread
From: Jakob L. Kreuze @ 2019-08-06 13:04 UTC (permalink / raw)
  To: swedebugia; +Cc: guix-devel

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

Ricardo Wurmus <rekado@elephly.net> writes:

> The error means that you tried to use #T as a procedure.
> “run-with-store” expects a monadic value. “git-fetch” returns #T,
> though, not a monadic value.

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'.

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 13:04   ` Jakob L. Kreuze
@ 2019-08-06 20:26     ` swedebugia
  2019-08-06 20:46       ` Jakob L. Kreuze
  2019-08-06 22:02       ` Ricardo Wurmus
  0 siblings, 2 replies; 8+ messages in thread
From: swedebugia @ 2019-08-06 20:26 UTC (permalink / raw)
  To: Jakob L. Kreuze; +Cc: guix-devel

[-- 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


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 20:26     ` swedebugia
@ 2019-08-06 20:46       ` Jakob L. Kreuze
  2019-08-06 22:02       ` Ricardo Wurmus
  1 sibling, 0 replies; 8+ messages in thread
From: Jakob L. Kreuze @ 2019-08-06 20:46 UTC (permalink / raw)
  To: swedebugia; +Cc: guix-devel

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

swedebugia <swedebugia@riseup.net> writes:

> Done! (see attached)
>
> I got the git-fetch and hashing to work. :D

Nice work!

> 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.

An easy solution (not necessarily the best solution) would be to wrap it
in 'with-output-to-string'.

Regards,
Jakob

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Go importer - help with git-fetch
  2019-08-06 20:26     ` swedebugia
  2019-08-06 20:46       ` Jakob L. Kreuze
@ 2019-08-06 22:02       ` Ricardo Wurmus
  1 sibling, 0 replies; 8+ messages in thread
From: Ricardo Wurmus @ 2019-08-06 22:02 UTC (permalink / raw)
  To: swedebugia; +Cc: guix-devel


swedebugia <swedebugia@riseup.net> writes:

> 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.

(parameterize ((current-error-port (%make-void-port "rw+"))
               (current-output-port (%make-void-port "rw+")))
   …)

-- 
Ricardo

^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2019-08-06 22:03 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-08-06 10:23 Go importer - help with git-fetch swedebugia
2019-08-06 10:26 ` Pierre Neidhardt
2019-08-06 12:45   ` swedebugia
2019-08-06 12:56 ` Ricardo Wurmus
2019-08-06 13:04   ` Jakob L. Kreuze
2019-08-06 20:26     ` swedebugia
2019-08-06 20:46       ` Jakob L. Kreuze
2019-08-06 22:02       ` Ricardo Wurmus

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).