From a78dcb3d599cc84b347578940bb0fd44b1ad50b4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 14 Sep 2019 17:46:34 +0200
Subject: git: 'update-cached-checkout' avoids network access when unnecessary.

* guix/git.scm (reference-available?): New procedure.
(update-cached-checkout): Avoid call to 'remote-fetch' when REPOSITORY
already contains REF.
---
 guix/git.scm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

(limited to 'guix/git.scm')

diff --git a/guix/git.scm b/guix/git.scm
index de98fed40c..92a7353b5a 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -220,6 +220,21 @@ dynamic extent of EXP."
               (G_ "Support for submodules is missing; \
 please upgrade Guile-Git.~%"))))
 
+(define (reference-available? repository ref)
+  "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
+definitely available in REPOSITORY, false otherwise."
+  (match ref
+    (('commit . commit)
+     (catch 'git-error
+       (lambda ()
+         (->bool (commit-lookup repository (string->oid commit))))
+       (lambda (key error . rest)
+         (if (= GIT_ENOTFOUND (git-error-code error))
+             #f
+             (apply throw key error rest)))))
+    (_
+     #f)))
+
 (define* (update-cached-checkout url
                                  #:key
                                  (ref '(branch . "master"))
@@ -254,7 +269,8 @@ When RECURSIVE? is true, check out submodules as well, if any."
                              (repository-open cache-directory)
                              (clone* url cache-directory))))
      ;; Only fetch remote if it has not been cloned just before.
-     (when cache-exists?
+     (when (and cache-exists?
+                (not (reference-available? repository ref)))
        (remote-fetch (remote-lookup repository "origin")))
      (when recursive?
        (update-submodules repository #:log-port log-port))
-- 
cgit v1.2.3