import: go: Upgrade go.mod parser.
[jackhill/guix/guix.git] / guix / import / go.scm
CommitLineData
02e2e093
KCB
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
3;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
4;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
5;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
d028aef3 6;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
426ade6c 7;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
793ba333 8;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
02e2e093
KCB
9;;;
10;;; This file is part of GNU Guix.
11;;;
12;;; GNU Guix is free software; you can redistribute it and/or modify it
13;;; under the terms of the GNU General Public License as published by
14;;; the Free Software Foundation; either version 3 of the License, or (at
15;;; your option) any later version.
16;;;
17;;; GNU Guix is distributed in the hope that it will be useful, but
18;;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;;; GNU General Public License for more details.
21;;;
22;;; You should have received a copy of the GNU General Public License
23;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
24
25(define-module (guix import go)
26 #:use-module (guix build-system go)
27 #:use-module (guix git)
28 #:use-module (guix i18n)
29 #:use-module (guix diagnostics)
30 #:use-module (guix import utils)
31 #:use-module (guix import json)
32 #:use-module (guix packages)
33 #:use-module ((guix utils) #:select (string-replace-substring))
34 #:use-module (guix http-client)
35 #:use-module ((guix licenses) #:prefix license:)
36 #:use-module (guix memoization)
34db952a 37 #:autoload (htmlprag) (html->sxml) ;from Guile-Lib
d028aef3
LC
38 #:autoload (guix git) (update-cached-checkout)
39 #:autoload (gcrypt hash) (open-hash-port hash-algorithm sha256)
40 #:autoload (guix serialization) (write-file)
41 #:autoload (guix base32) (bytevector->nix-base32-string)
42 #:autoload (guix build utils) (mkdir-p)
02e2e093 43 #:use-module (ice-9 match)
793ba333 44 #:use-module (ice-9 peg)
02e2e093
KCB
45 #:use-module (ice-9 rdelim)
46 #:use-module (ice-9 receive)
47 #:use-module (ice-9 regex)
6aee902e 48 #:use-module (ice-9 textual-ports)
02e2e093
KCB
49 #:use-module ((rnrs io ports) #:select (call-with-port))
50 #:use-module (srfi srfi-1)
6aee902e 51 #:use-module (srfi srfi-2)
02e2e093
KCB
52 #:use-module (srfi srfi-9)
53 #:use-module (srfi srfi-11)
54 #:use-module (srfi srfi-26)
a8b927a5 55 #:use-module (srfi srfi-34)
6aee902e
MC
56 #:use-module (sxml match)
57 #:use-module ((sxml xpath) #:renamer (lambda (s)
58 (if (eq? 'filter s)
59 'xfilter
60 s)))
02e2e093
KCB
61 #:use-module (web client)
62 #:use-module (web response)
63 #:use-module (web uri)
64
6aee902e 65 #:export (go-module->guix-package
02e2e093
KCB
66 go-module-recursive-import))
67
68;;; Commentary:
69;;;
70;;; (guix import go) attempts to make it easier to create Guix package
71;;; declarations for Go modules.
72;;;
73;;; Modules in Go are a "collection of related Go packages" which are "the
74;;; unit of source code interchange and versioning". Modules are generally
75;;; hosted in a repository.
76;;;
77;;; At this point it should handle correctly modules which have only Go
78;;; dependencies and are accessible from proxy.golang.org (or configured via
79;;; GOPROXY).
80;;;
81;;; We want it to work more or less this way:
82;;; - get latest version for the module from GOPROXY
83;;; - infer VCS root repo from which we will check-out source by
84;;; + recognising known patterns (like github.com)
85;;; + or recognizing .vcs suffix
86;;; + or parsing meta tag in HTML served at the URL
87;;; + or (TODO) if nothing else works by using zip file served by GOPROXY
88;;; - get go.mod from GOPROXY (which is able to synthetize one if needed)
89;;; - extract list of dependencies from this go.mod
90;;;
91;;; The Go module paths are translated to a Guix package name under the
92;;; assumption that there will be no collision.
93
94;;; TODO list
a8b927a5 95;;; - get correct hash in vcs->origin for Mercurial and Subversion
02e2e093
KCB
96
97;;; Code:
98
6aee902e
MC
99(define http-fetch*
100 ;; Like http-fetch, but memoized and returning the body as a string.
101 (memoize (lambda args
102 (call-with-port (apply http-fetch args) get-string-all))))
103
104(define json-fetch*
105 (memoize json-fetch))
106
02e2e093
KCB
107(define (go-path-escape path)
108 "Escape a module path by replacing every uppercase letter with an
109exclamation mark followed with its lowercase equivalent, as per the module
110Escaped Paths specification (see:
111https://godoc.org/golang.org/x/mod/module#hdr-Escaped_Paths)."
112 (define (escape occurrence)
113 (string-append "!" (string-downcase (match:substring occurrence))))
114 (regexp-substitute/global #f "[A-Z]" path 'pre escape 'post))
115
6aee902e
MC
116;; Prevent inlining of this procedure, which is accessed by unit tests.
117(set! go-path-escape go-path-escape)
118
119(define (go.pkg.dev-info name)
120 (http-fetch* (string-append "https://pkg.go.dev/" name)))
121
a8b927a5
MC
122(define* (go-module-version-string goproxy name #:key version)
123 "Fetch the version string of the latest version for NAME from the given
124GOPROXY server, or for VERSION when specified."
125 (let ((file (if version
126 (string-append "@v/" version ".info")
127 "@latest")))
128 (assoc-ref (json-fetch* (format #f "~a/~a/~a"
129 goproxy (go-path-escape name) file))
130 "Version")))
131
132(define* (go-module-available-versions goproxy name)
133 "Retrieve the available versions for a given module from the module proxy.
134Versions are being returned **unordered** and may contain different versioning
135styles for the same package."
136 (let* ((url (string-append goproxy "/" (go-path-escape name) "/@v/list"))
137 (body (http-fetch* url))
138 (versions (remove string-null? (string-split body #\newline))))
139 (if (null? versions)
140 (list (go-module-version-string goproxy name)) ;latest version
141 versions)))
02e2e093 142
02e2e093
KCB
143(define (go-package-licenses name)
144 "Retrieve the list of licenses that apply to NAME, a Go package or module
6aee902e
MC
145name (e.g. \"github.com/golang/protobuf/proto\")."
146 (let* ((body (go.pkg.dev-info (string-append name "?tab=licenses")))
147 ;; Extract the text contained in a h2 child node of any
148 ;; element marked with a "License" class attribute.
149 (select (sxpath `(// (* (@ (equal? (class "License"))))
59d20bcf 150 h2 // div // *text*))))
55e90e55 151 (select (html->sxml body #:strict? #t))))
6aee902e
MC
152
153(define (sxml->texi sxml-node)
154 "A very basic SXML to Texinfo converter which attempts to preserve HTML
155formatting and links as text."
156 (sxml-match sxml-node
157 ((strong ,text)
158 (format #f "@strong{~a}" text))
159 ((a (@ (href ,url)) ,text)
160 (format #f "@url{~a,~a}" url text))
161 ((code ,text)
162 (format #f "@code{~a}" text))
163 (,something-else something-else)))
02e2e093
KCB
164
165(define (go-package-description name)
166 "Retrieve a short description for NAME, a Go package name,
6aee902e
MC
167e.g. \"google.golang.org/protobuf/proto\"."
168 (let* ((body (go.pkg.dev-info name))
55e90e55 169 (sxml (html->sxml body #:strict? #t))
6aee902e
MC
170 (overview ((sxpath
171 `(//
172 (* (@ (equal? (class "Documentation-overview"))))
173 (p 1))) sxml))
174 ;; Sometimes, the first paragraph just contains images/links that
175 ;; has only "\n" for text. The following filter is designed to
176 ;; omit it.
177 (contains-text? (lambda (node)
178 (remove string-null?
179 (map string-trim-both
180 (filter (node-typeof? '*text*)
181 (cdr node))))))
182 (select-content (sxpath
183 `(//
184 (* (@ (equal? (class "UnitReadme-content"))))
185 div // p ,(xfilter contains-text?))))
186 ;; Fall-back to use content; this is less desirable as it is more
187 ;; verbose, but not every page has an overview.
188 (description (if (not (null? overview))
189 overview
190 (select-content sxml)))
9d915242
SMG
191 (description* (if (not (null? description))
192 (first description)
193 description)))
6aee902e
MC
194 (match description*
195 (() #f) ;nothing selected
196 ((p elements ...)
197 (apply string-append (filter string? (map sxml->texi elements)))))))
02e2e093
KCB
198
199(define (go-package-synopsis module-name)
200 "Retrieve a short synopsis for a Go module named MODULE-NAME,
201e.g. \"google.golang.org/protobuf\". The data is scraped from
202the https://pkg.go.dev/ web site."
203 ;; Note: Only the *module* (rather than package) page has the README title
204 ;; used as a synopsis on the https://pkg.go.dev web site.
6aee902e
MC
205 (let* ((url (string-append "https://pkg.go.dev/" module-name))
206 (body (http-fetch* url))
207 ;; Extract the text contained in a h2 child node of any
208 ;; element marked with a "License" class attribute.
209 (select-title (sxpath
210 `(// (div (@ (equal? (class "UnitReadme-content"))))
211 // h3 *text*))))
55e90e55 212 (match (select-title (html->sxml body #:strict? #t))
6aee902e
MC
213 (() #f) ;nothing selected
214 ((title more ...) ;title is the first string of the list
215 (string-trim-both title)))))
02e2e093
KCB
216
217(define (list->licenses licenses)
218 "Given a list of LICENSES mostly following the SPDX conventions, return the
219corresponding Guix license or 'unknown-license!"
220 (filter-map (lambda (license)
221 (and (not (string-null? license))
222 (not (any (cut string=? <> license)
223 '("AND" "OR" "WITH")))
224 ;; Adjust the license names scraped from
225 ;; https://pkg.go.dev to an equivalent SPDX identifier,
226 ;; if they differ (see: https://github.com/golang/pkgsite
227 ;; /internal/licenses/licenses.go#L174).
228 (or (spdx-string->license
229 (match license
230 ("BlueOak-1.0" "BlueOak-1.0.0")
231 ("BSD-0-Clause" "0BSD")
232 ("BSD-2-Clause" "BSD-2-Clause-FreeBSD")
233 ("GPL2" "GPL-2.0")
234 ("GPL3" "GPL-3.0")
235 ("NIST" "NIST-PD")
236 (_ license)))
237 'unknown-license!)))
238 licenses))
239
6aee902e
MC
240(define (fetch-go.mod goproxy module-path version)
241 "Fetch go.mod from the given GOPROXY server for the given MODULE-PATH
242and VERSION and return an input port."
243 (let ((url (format #f "~a/~a/@v/~a.mod" goproxy
02e2e093
KCB
244 (go-path-escape module-path)
245 (go-path-escape version))))
6aee902e 246 (http-fetch* url)))
02e2e093 247
02e2e093 248
6aee902e 249(define (parse-go.mod content)
793ba333
SM
250 "Parse the go.mod file CONTENT, returning a list of directives, comments,
251and unknown lines. Each sublist begins with a symbol (go, module, require,
252replace, exclude, retract, comment, or unknown) and is followed by one or more
253sublists. Each sublist begins with a symbol (module-path, version, file-path,
254comment, or unknown) and is followed by the indicated data."
255 ;; https://golang.org/ref/mod#go-mod-file-grammar
256 (define-peg-pattern NL none "\n")
257 (define-peg-pattern WS none (or " " "\t" "\r"))
258 (define-peg-pattern => none (and (* WS) "=>"))
259 (define-peg-pattern punctuation none (or "," "=>" "[" "]" "(" ")"))
260 (define-peg-pattern comment all
261 (and (ignore "//") (* WS) (* (and (not-followed-by NL) peg-any))))
262 (define-peg-pattern EOL body (and (* WS) (? comment) NL))
263 (define-peg-pattern block-start none (and (* WS) "(" EOL))
264 (define-peg-pattern block-end none (and (* WS) ")" EOL))
265 (define-peg-pattern any-line body
266 (and (* WS) (* (and (not-followed-by NL) peg-any)) EOL))
267
268 ;; Strings and identifiers
269 (define-peg-pattern identifier body
270 (+ (and (not-followed-by (or NL WS punctuation)) peg-any)))
271 (define-peg-pattern string-raw body
272 (and (ignore "`") (+ (and (not-followed-by "`") peg-any)) (ignore "`")))
273 (define-peg-pattern string-quoted body
274 (and (ignore "\"")
275 (+ (or (and (ignore "\\") peg-any)
276 (and (not-followed-by "\"") peg-any)))
277 (ignore "\"")))
278 (define-peg-pattern string-or-ident body
279 (and (* WS) (or string-raw string-quoted identifier)))
280
281 (define-peg-pattern version all string-or-ident)
282 (define-peg-pattern module-path all string-or-ident)
283 (define-peg-pattern file-path all string-or-ident)
284
285 ;; Non-directive lines
286 (define-peg-pattern unknown all any-line)
287 (define-peg-pattern block-line body
288 (or EOL (and (not-followed-by block-end) unknown)))
289
290 ;; GoDirective = "go" GoVersion newline .
291 (define-peg-pattern go all (and (ignore "go") version EOL))
292
293 ;; ModuleDirective = "module" ( ModulePath | "(" newline ModulePath newline ")" ) newline .
294 (define-peg-pattern module all
295 (and (ignore "module") (or (and block-start module-path EOL block-end)
296 (and module-path EOL))))
297
298 ;; The following directives may all be used solo or in a block
299 ;; RequireSpec = ModulePath Version newline .
300 (define-peg-pattern require all (and module-path version EOL))
301 (define-peg-pattern require-top body
302 (and (ignore "require")
303 (or (and block-start (* (or require block-line)) block-end) require)))
304
305 ;; ExcludeSpec = ModulePath Version newline .
306 (define-peg-pattern exclude all (and module-path version EOL))
307 (define-peg-pattern exclude-top body
308 (and (ignore "exclude")
309 (or (and block-start (* (or exclude block-line)) block-end) exclude)))
310
311 ;; ReplaceSpec = ModulePath [ Version ] "=>" FilePath newline
312 ;; | ModulePath [ Version ] "=>" ModulePath Version newline .
313 (define-peg-pattern original all (or (and module-path version) module-path))
314 (define-peg-pattern with all (or (and module-path version) file-path))
315 (define-peg-pattern replace all (and original => with EOL))
316 (define-peg-pattern replace-top body
317 (and (ignore "replace")
318 (or (and block-start (* (or replace block-line)) block-end) replace)))
319
320 ;; RetractSpec = ( Version | "[" Version "," Version "]" ) newline .
321 (define-peg-pattern range all
322 (and (* WS) (ignore "[") version
323 (* WS) (ignore ",") version (* WS) (ignore "]")))
324 (define-peg-pattern retract all (and (or range version) EOL))
325 (define-peg-pattern retract-top body
326 (and (ignore "retract")
327 (or (and block-start (* (or retract block-line)) block-end) retract)))
328
329 (define-peg-pattern go-mod body
330 (* (and (* WS) (or go module require-top exclude-top replace-top
331 retract-top EOL unknown))))
332
333 (let ((tree (peg:tree (match-pattern go-mod content)))
334 (keywords '(go module require replace exclude retract comment unknown)))
335 (keyword-flatten keywords tree)))
02e2e093
KCB
336
337;; Prevent inlining of this procedure, which is accessed by unit tests.
338(set! parse-go.mod parse-go.mod)
339
793ba333
SM
340(define (go.mod-directives go.mod directive)
341 "Return the list of top-level directive bodies in GO.MOD matching the symbol
342DIRECTIVE."
343 (filter-map (match-lambda
344 (((? (cut eq? <> directive) head) . rest) rest)
345 (_ #f))
346 go.mod))
347
348(define (go.mod-requirements go.mod)
349 "Compute and return the list of requirements specified by GO.MOD."
350 (define (replace directive requirements)
351 (define (maybe-replace module-path new-requirement)
352 ;; Do not allow version updates for indirect dependencies (see:
353 ;; https://golang.org/ref/mod#go-mod-file-replace).
354 (if (and (equal? module-path (first new-requirement))
355 (not (assoc-ref requirements module-path)))
356 requirements
357 (cons new-requirement (alist-delete module-path requirements))))
358
359 (match directive
360 ((('original ('module-path module-path) . _) with . _)
361 (match with
362 (('with ('file-path _) . _)
363 (alist-delete module-path requirements))
364 (('with ('module-path new-module-path) ('version new-version) . _)
365 (maybe-replace module-path
366 (list new-module-path new-version)))))))
367
368 (define (require directive requirements)
369 (match directive
370 ((('module-path module-path) ('version version) . _)
371 (cons (list module-path version) requirements))))
372
373 (let* ((requires (go.mod-directives go.mod 'require))
374 (replaces (go.mod-directives go.mod 'replace))
375 (requirements (fold require '() requires)))
376 (fold replace requirements replaces)))
377
378;; Prevent inlining of this procedure, which is accessed by unit tests.
379(set! go.mod-requirements go.mod-requirements)
380
02e2e093
KCB
381(define-record-type <vcs>
382 (%make-vcs url-prefix root-regex type)
383 vcs?
384 (url-prefix vcs-url-prefix)
385 (root-regex vcs-root-regex)
386 (type vcs-type))
6aee902e 387
02e2e093 388(define (make-vcs prefix regexp type)
6aee902e
MC
389 (%make-vcs prefix (make-regexp regexp) type))
390
02e2e093
KCB
391(define known-vcs
392 ;; See the following URL for the official Go equivalent:
393 ;; https://github.com/golang/go/blob/846dce9d05f19a1f53465e62a304dea21b99f910/src/cmd/go/internal/vcs/vcs.go#L1026-L1087
394 (list
395 (make-vcs
396 "github.com"
397 "^(github\\.com/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
398 'git)
399 (make-vcs
400 "bitbucket.org"
401 "^(bitbucket\\.org/([A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+))(/[A-Za-z0-9_.\\-]+)*$"
402 'unknown)
403 (make-vcs
404 "hub.jazz.net/git/"
405 "^(hub\\.jazz\\.net/git/[a-z0-9]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
406 'git)
407 (make-vcs
408 "git.apache.org"
409 "^(git\\.apache\\.org/[a-z0-9_.\\-]+\\.git)(/[A-Za-z0-9_.\\-]+)*$"
410 'git)
411 (make-vcs
412 "git.openstack.org"
413 "^(git\\.openstack\\.org/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(\\.git)?\
414(/[A-Za-z0-9_.\\-]+)*$"
415 'git)))
416
417(define (module-path->repository-root module-path)
418 "Infer the repository root from a module path. Go modules can be
419defined at any level of a repository tree, but querying for the meta tag
420usually can only be done from the web page at the root of the repository,
421hence the need to derive this information."
422
423 ;; For reference, see: https://golang.org/ref/mod#vcs-find.
424 (define vcs-qualifiers '(".bzr" ".fossil" ".git" ".hg" ".svn"))
425
426 (define (vcs-qualified-module-path->root-repo-url module-path)
427 (let* ((vcs-qualifiers-group (string-join vcs-qualifiers "|"))
428 (pattern (format #f "^(.*(~a))(/|$)" vcs-qualifiers-group))
429 (m (string-match pattern module-path)))
430 (and=> m (cut match:substring <> 1))))
431
432 (or (and=> (find (lambda (vcs)
433 (string-prefix? (vcs-url-prefix vcs) module-path))
434 known-vcs)
435 (lambda (vcs)
436 (match:substring (regexp-exec (vcs-root-regex vcs)
437 module-path) 1)))
438 (vcs-qualified-module-path->root-repo-url module-path)
439 module-path))
440
83f8b6d3
MC
441(define* (go-module->guix-package-name module-path #:optional version)
442 "Converts a module's path to the canonical Guix format for Go packages.
443Optionally include a VERSION string to append to the name."
b1a419ea 444 ;; Map dot, slash, underscore and tilde characters to hyphens.
83f8b6d3 445 (let ((module-path* (string-map (lambda (c)
b1a419ea 446 (if (member c '(#\. #\/ #\_ #\~))
83f8b6d3
MC
447 #\-
448 c))
449 module-path)))
450 (string-downcase (string-append "go-" module-path*
451 (if version
452 (string-append "-" version)
453 "")))))
02e2e093 454
6aee902e
MC
455(define (strip-.git-suffix/maybe repo-url)
456 "Strip a repository URL '.git' suffix from REPO-URL if hosted at GitHub."
457 (match repo-url
458 ((and (? (cut string-prefix? "https://github.com" <>))
459 (? (cut string-suffix? ".git" <>)))
460 (string-drop-right repo-url 4))
461 (_ repo-url)))
462
02e2e093
KCB
463(define-record-type <module-meta>
464 (make-module-meta import-prefix vcs repo-root)
465 module-meta?
466 (import-prefix module-meta-import-prefix)
467 (vcs module-meta-vcs) ;a symbol
468 (repo-root module-meta-repo-root))
469
470(define (fetch-module-meta-data module-path)
471 "Retrieve the module meta-data from its landing page. This is necessary
472because goproxy servers don't currently provide all the information needed to
473build a package."
5eba9c09
SMG
474 (define (go-import->module-meta content-text)
475 (match (string-split content-text #\space)
476 ((root-path vcs repo-url)
477 (make-module-meta root-path (string->symbol vcs)
478 (strip-.git-suffix/maybe repo-url)))))
02e2e093 479 ;; <meta name="go-import" content="import-prefix vcs repo-root">
6aee902e 480 (let* ((meta-data (http-fetch* (format #f "https://~a?go-get=1" module-path)))
02e2e093
KCB
481 (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
482 // content))))
55e90e55 483 (match (select (html->sxml meta-data #:strict? #t))
6aee902e 484 (() #f) ;nothing selected
5eba9c09
SMG
485 ((('content content-text) ..1)
486 (find (lambda (meta)
487 (string-prefix? (module-meta-import-prefix meta) module-path))
488 (map go-import->module-meta content-text))))))
02e2e093 489
6aee902e 490(define (module-meta-data-repo-url meta-data goproxy)
02e2e093
KCB
491 "Return the URL where the fetcher which will be used can download the
492source."
493 (if (member (module-meta-vcs meta-data) '(fossil mod))
6aee902e 494 goproxy
02e2e093
KCB
495 (module-meta-repo-root meta-data)))
496
d028aef3
LC
497;; XXX: Copied from (guix scripts hash).
498(define (vcs-file? file stat)
499 (case (stat:type stat)
500 ((directory)
501 (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
502 ((regular)
503 ;; Git sub-modules have a '.git' file that is a regular text file.
504 (string=? (basename file) ".git"))
505 (else
506 #f)))
507
508;; XXX: Adapted from 'file-hash' in (guix scripts hash).
509(define* (file-hash file #:optional (algorithm (hash-algorithm sha256)))
510 ;; Compute the hash of FILE.
511 (let-values (((port get-hash) (open-hash-port algorithm)))
512 (write-file file port #:select? (negate vcs-file?))
513 (force-output port)
514 (get-hash)))
515
516(define* (git-checkout-hash url reference algorithm)
517 "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
518tag."
519 (define cache
520 (string-append (or (getenv "TMPDIR") "/tmp")
521 "/guix-import-go-"
522 (passwd:name (getpwuid (getuid)))))
523
524 ;; Use a custom cache to avoid cluttering the default one under
525 ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
526 ;; subsequent "guix import" invocations.
527 (mkdir-p cache)
528 (chmod cache #o700)
529 (let-values (((checkout commit _)
530 (parameterize ((%repository-cache-directory cache))
531 (update-cached-checkout url
532 #:ref
533 `(tag-or-commit . ,reference)))))
534 (file-hash checkout algorithm)))
535
02e2e093
KCB
536(define (vcs->origin vcs-type vcs-repo-url version)
537 "Generate the `origin' block of a package depending on what type of source
538control system is being used."
539 (case vcs-type
540 ((git)
541 (let ((plain-version? (string=? version (go-version->git-ref version)))
542 (v-prefixed? (string-prefix? "v" version)))
543 `(origin
544 (method git-fetch)
545 (uri (git-reference
546 (url ,vcs-repo-url)
6aee902e
MC
547 ;; This is done because the version field of the package,
548 ;; which the generated quoted expression refers to, has been
549 ;; stripped of any 'v' prefixed.
02e2e093
KCB
550 (commit ,(if (and plain-version? v-prefixed?)
551 '(string-append "v" version)
552 '(go-version->git-ref version)))))
553 (file-name (git-file-name name version))
554 (sha256
555 (base32
d028aef3
LC
556 ,(bytevector->nix-base32-string
557 (git-checkout-hash vcs-repo-url (go-version->git-ref version)
558 (hash-algorithm sha256))))))))
02e2e093
KCB
559 ((hg)
560 `(origin
561 (method hg-fetch)
562 (uri (hg-reference
563 (url ,vcs-repo-url)
564 (changeset ,version)))
565 (file-name (string-append name "-" version "-checkout"))
566 (sha256
567 (base32
568 ;; FIXME: populate hash for hg repo checkout
569 "0000000000000000000000000000000000000000000000000000"))))
570 ((svn)
571 `(origin
572 (method svn-fetch)
573 (uri (svn-reference
574 (url ,vcs-repo-url)
575 (revision (string->number version))))
576 (file-name (string-append name "-" version "-checkout"))
577 (sha256
578 (base32
579 ;; FIXME: populate hash for svn repo checkout
580 "0000000000000000000000000000000000000000000000000000"))))
581 (else
582 (raise
583 (formatted-message (G_ "unsupported vcs type '~a' for package '~a'")
584 vcs-type vcs-repo-url)))))
585
586(define* (go-module->guix-package module-path #:key
a8b927a5
MC
587 (goproxy "https://proxy.golang.org")
588 version
589 pin-versions?)
590 "Return the package S-expression corresponding to MODULE-PATH at VERSION, a Go package.
591The meta-data is fetched from the GOPROXY server and https://pkg.go.dev/.
592When VERSION is unspecified, the latest version available is used."
593 (let* ((available-versions (go-module-available-versions goproxy module-path))
594 (version* (or version
595 (go-module-version-string goproxy module-path))) ;latest
83f8b6d3
MC
596 ;; Elide the "v" prefix Go uses.
597 (strip-v-prefix (cut string-trim <> #\v))
a8b927a5
MC
598 ;; Pseudo-versions do not appear in the versions list; skip the
599 ;; following check.
600 (_ (unless (or (go-pseudo-version? version*)
601 (member version* available-versions))
602 (error (format #f "error: version ~s is not available
603hint: use one of the following available versions ~a\n"
604 version* available-versions))))
605 (content (fetch-go.mod goproxy module-path version*))
793ba333 606 (dependencies+versions (go.mod-requirements (parse-go.mod content)))
83f8b6d3
MC
607 (dependencies (if pin-versions?
608 dependencies+versions
609 (map car dependencies+versions)))
02e2e093
KCB
610 (guix-name (go-module->guix-package-name module-path))
611 (root-module-path (module-path->repository-root module-path))
612 ;; The VCS type and URL are not included in goproxy information. For
613 ;; this we need to fetch it from the official module page.
614 (meta-data (fetch-module-meta-data root-module-path))
615 (vcs-type (module-meta-vcs meta-data))
a8b927a5 616 (vcs-repo-url (module-meta-data-repo-url meta-data goproxy))
02e2e093
KCB
617 (synopsis (go-package-synopsis root-module-path))
618 (description (go-package-description module-path))
619 (licenses (go-package-licenses module-path)))
620 (values
621 `(package
622 (name ,guix-name)
83f8b6d3 623 (version ,(strip-v-prefix version*))
02e2e093 624 (source
a8b927a5 625 ,(vcs->origin vcs-type vcs-repo-url version*))
02e2e093
KCB
626 (build-system go-build-system)
627 (arguments
628 '(#:import-path ,root-module-path))
83f8b6d3
MC
629 ,@(maybe-propagated-inputs
630 (map (match-lambda
631 ((name version)
632 (go-module->guix-package-name name (strip-v-prefix version)))
633 (name
634 (go-module->guix-package-name name)))
635 dependencies))
02e2e093
KCB
636 (home-page ,(format #f "https://~a" root-module-path))
637 (synopsis ,synopsis)
6aee902e
MC
638 (description ,(and=> description beautify-description))
639 (license ,(match (list->licenses licenses)
83f8b6d3
MC
640 (() #f) ;unknown license
641 ((license) ;a single license
6aee902e 642 license)
83f8b6d3 643 ((license ...) ;a list of licenses
6aee902e 644 `(list ,@license)))))
a8b927a5
MC
645 (if pin-versions?
646 dependencies+versions
647 dependencies))))
02e2e093
KCB
648
649(define go-module->guix-package* (memoize go-module->guix-package))
650
651(define* (go-module-recursive-import package-name
a8b927a5
MC
652 #:key (goproxy "https://proxy.golang.org")
653 version
654 pin-versions?)
655
02e2e093
KCB
656 (recursive-import
657 package-name
a8b927a5
MC
658 #:repo->guix-package
659 (lambda* (name #:key version repo)
660 ;; Disable output buffering so that the following warning gets printed
661 ;; consistently.
662 (setvbuf (current-error-port) 'none)
663 (guard (c ((http-get-error? c)
664 (warning (G_ "Failed to import package ~s.
665reason: ~s could not be fetched: HTTP error ~a (~s).
666This package and its dependencies won't be imported.~%")
667 name
668 (uri->string (http-get-error-uri c))
669 (http-get-error-code c)
670 (http-get-error-reason c))
671 (values '() '())))
672 (receive (package-sexp dependencies)
673 (go-module->guix-package* name #:goproxy goproxy
674 #:version version
675 #:pin-versions? pin-versions?)
676 (values package-sexp dependencies))))
677 #:guix-name go-module->guix-package-name
678 #:version version))