import: Factorize file hashing.

* guix/import/cran.scm (vcs-file?, file-hash): Remove procedures.
  (description->package): Use 'file-hash*' instead.
* guix/import/elpa.scm (vcs-file?, file-hash): Remove procedures.
  (git-repository->origin, elpa-package->sexp): Use 'file-hash* instead'.
* guix/import/go.scm (vcs-file?, file-hash): Remove procedures.
  (git-checkout-hash): Use 'file-hash*' instead.
* guix/import/minetest.scm (file-hash): Remove procedure.
  (make-minetest-sexp): Use 'file-hash*' instead.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

4 files changed, 19 insertions, 86 deletions

diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..b61402078d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt hash)
   #:use-module (guix store)
-  #:use-module ((guix serialization) #:select (write-file))
   #:use-module (guix base32)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
@@ -196,17 +196,6 @@ bioconductor package NAME, or #F if the package is unknown."
                (bioconductor-packages-list type))
          (cut assoc-ref <> "Version")))
 
-;; XXX taken 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)))
-
 ;; Little helper to download URLs only once.
 (define download
   (memoize
@@ -464,16 +453,6 @@ reference the pkg-config tool."
 (define (needs-knitr? meta)
   (member "knitr" (listify meta "VignetteBuilder")))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file select? recursive?)
-  ;; Compute the hash of FILE.
-  (if recursive?
-      (let-values (((port get-hash) (open-sha256-port)))
-        (write-file file port #:select? select?)
-        (force-output port)
-        (get-hash))
-      (call-with-input-file file port-sha256)))
-
 (define (description->package repository meta)
   "Return the `package' s-expression for an R package published on REPOSITORY
 from the alist META, which was derived from the R package's DESCRIPTION file."
@@ -571,12 +550,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
                         (sha256
                          (base32
                           ,(bytevector->nix-base32-string
-                            (case repository
-                              ((git)
-                               (file-hash source (negate vcs-file?) #t))
-                              ((hg)
-                               (file-hash source (negate vcs-file?) #t))
-                              (else (file-sha256 source))))))))
+                            (file-hash* source #:recursive? (or git? hg?)))))))
               ,@(if (not (and git? hg?
                               (equal? (string-append "r-" name)
                                       (cran-guix-name name))))
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 5a092ebdc2..ea77a7c244 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,10 @@
   #:use-module (guix import utils)
   #:use-module (guix http-client)
   #:use-module (guix git)
+  #:use-module (guix hash)
   #:use-module ((guix serialization) #:select (write-file))
   #:use-module (guix store)
   #:use-module (guix ui)
-  #:use-module (gcrypt hash)
   #:use-module (guix base32)
   #:use-module (guix upstream)
   #:use-module (guix packages)
@@ -230,27 +231,6 @@ keywords to values."
     (close-port port)
     (data->recipe (cons ':name data))))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file select? recursive?)
-  ;; Compute the hash of FILE.
-  (if recursive?
-      (let-values (((port get-hash) (open-sha256-port)))
-        (write-file file port #:select? select?)
-        (force-output port)
-        (get-hash))
-      (call-with-input-file file port-sha256)))
-
-;; XXX taken 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)))
-
 (define (git-repository->origin recipe url)
   "Fetch origin details from the Git repository at URL for the provided MELPA
 RECIPE."
@@ -272,7 +252,7 @@ RECIPE."
        (sha256
         (base32
          ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+           (file-hash* directory #:recursive? #true)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -381,7 +361,8 @@ type '<elpa-package>'."
                         (sha256
                          (base32
                           ,(if tarball
-                               (bytevector->nix-base32-string (file-sha256 tarball))
+                               (bytevector->nix-base32-string
+                                (file-hash* tarball #:recursive? #false))
                                "failed to download package")))))))
       (build-system emacs-build-system)
       ,@(maybe-inputs 'propagated-inputs dependencies)
diff --git a/guix/import/go.scm b/guix/import/go.scm
index 26dbc34b63..c7673e6a1a 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,7 @@
 (define-module (guix import go)
   #:use-module (guix build-system go)
   #:use-module (guix git)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
   #:use-module (guix diagnostics)
   #:use-module (guix import utils)
@@ -36,11 +37,10 @@
   #: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)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,6 @@ source."
       goproxy
       (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."
@@ -536,7 +517,7 @@ tag."
                   (update-cached-checkout url
                                           #:ref
                                           `(tag-or-commit . ,reference)))))
-    (file-hash checkout algorithm)))
+    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..a7bdbfebca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,13 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true)
+                   #:recursive? #true)))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))