import: go: Compute the hash of Git checkouts.

* guix/import/go.scm (vcs-file?, file-hash, git-checkout-hash): New
procedures.
(vcs->origin): Use 'git-checkout-hash' in the 'git case.

2 files changed, 65 insertions, 8 deletions

diff --git a/guix/import/go.scm b/guix/import/go.scm
index 6b10c60dca..7452b4c903 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
 ;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +33,11 @@
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix memoization)
   #:autoload   (htmlprag) (html->sxml)            ;from Guile-Lib
+  #:autoload   (guix git) (update-cached-checkout)
+  #:autoload   (gcrypt hash) (open-hash-port hash-algorithm sha256)
+  #:autoload   (guix serialization) (write-file)
+  #:autoload   (guix base32) (bytevector->nix-base32-string)
+  #:autoload   (guix build utils) (mkdir-p)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 receive)
@@ -407,6 +413,45 @@ source."
       goproxy-url
       (module-meta-repo-root meta-data)))
 
+;; XXX: Copied from (guix scripts hash).
+(define (vcs-file? file stat)
+  (case (stat:type stat)
+    ((directory)
+     (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+    ((regular)
+     ;; Git sub-modules have a '.git' file that is a regular text file.
+     (string=? (basename file) ".git"))
+    (else
+     #f)))
+
+;; XXX: Adapted from 'file-hash' in (guix scripts hash).
+(define* (file-hash file #:optional (algorithm (hash-algorithm sha256)))
+  ;; Compute the hash of FILE.
+  (let-values (((port get-hash) (open-hash-port algorithm)))
+    (write-file file port #:select? (negate vcs-file?))
+    (force-output port)
+    (get-hash)))
+
+(define* (git-checkout-hash url reference algorithm)
+  "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
+tag."
+  (define cache
+    (string-append (or (getenv "TMPDIR") "/tmp")
+                   "/guix-import-go-"
+                   (passwd:name (getpwuid (getuid)))))
+
+  ;; Use a custom cache to avoid cluttering the default one under
+  ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
+  ;; subsequent "guix import" invocations.
+  (mkdir-p cache)
+  (chmod cache #o700)
+  (let-values (((checkout commit _)
+                (parameterize ((%repository-cache-directory cache))
+                  (update-cached-checkout url
+                                          #:ref
+                                          `(tag-or-commit . ,reference)))))
+    (file-hash checkout algorithm)))
+
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
 control system is being used."
@@ -424,8 +469,9 @@ control system is being used."
           (file-name (git-file-name name version))
           (sha256
            (base32
-            ;; FIXME: populate hash for git repo checkout
-            "0000000000000000000000000000000000000000000000000000")))))
+            ,(bytevector->nix-base32-string
+              (git-checkout-hash vcs-repo-url (go-version->git-ref version)
+                                 (hash-algorithm sha256))))))))
     ((hg)
      `(origin
         (method hg-fetch)
diff --git a/tests/go.scm b/tests/go.scm
index 1df5036838..6ab99f508a 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -23,6 +23,8 @@
   #:use-module (guix base32)
   #:use-module (guix build-system go)
   #:use-module (guix import go)
+  #:use-module (guix base32)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module (guix tests)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-19)
@@ -258,7 +260,7 @@ require github.com/kr/pretty v0.2.1
        (file-name (git-file-name name version))
        (sha256
         (base32
-         "0000000000000000000000000000000000000000000000000000"))))
+         "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
     (build-system go-build-system)
     (arguments
      (quote (#:import-path "github.com/go-check/check")))
@@ -271,11 +273,20 @@ require github.com/kr/pretty v0.2.1
     (license license:bsd-2))
 
   ;; Replace network resources with sample data.
-  (mock ((web client) http-get
-         (mock-http-get fixtures-go-check-test))
-    (mock ((guix http-client) http-fetch
-           (mock-http-fetch fixtures-go-check-test))
-       (go-module->guix-package "github.com/go-check/check"))))
+  (call-with-temporary-directory
+   (lambda (checkout)
+     (mock ((web client) http-get
+            (mock-http-get fixtures-go-check-test))
+           (mock ((guix http-client) http-fetch
+                  (mock-http-fetch fixtures-go-check-test))
+                 (mock ((guix git) update-cached-checkout
+                        (lambda* (url #:key ref)
+                          ;; Return an empty directory and its hash.
+                          (values checkout
+                                  (nix-base32-string->bytevector
+                                   "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
+                                  #f)))
+                       (go-module->guix-package "github.com/go-check/check")))))))
 
 (test-end "go")