03/08: import: elpa: Use 'http-fetch/cached' to retrieve the archive.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 218622a73794c3b0d0d81db9176a59125c58df41
Author: Ludovic Courtès <address@hidden>
Date:   Wed Oct 21 12:12:59 2015 +0200

    import: elpa: Use 'http-fetch/cached' to retrieve the archive.
    
    * guix/import/elpa.scm (elpa-fetch-archive): Set %HTTP-CACHE-TTL to 6
      hours.
      (call-with-downloaded-file): Use 'http-fetch/cached' instead of
      'url-fetch'.
---
 guix/import/elpa.scm |   14 ++++++--------
 1 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index b3a3a96..d327925 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -19,6 +19,7 @@
 (define-module (guix import elpa)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -26,6 +27,7 @@
   #:use-module (srfi srfi-26)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
+  #:use-module (guix http-client)
   #:use-module (guix store)
   #:use-module (guix ui)
   #:use-module (guix hash)
@@ -74,20 +76,16 @@ NAMES (strings)."
   (let ((url (and=> (elpa-url repo)
                     (cut string-append <> "/archive-contents"))))
     (if url
-        (call-with-downloaded-file url read)
+        ;; Use a relatively small TTL for the archive itself.
+        (parameterize ((%http-cache-ttl (* 6 3600)))
+          (call-with-downloaded-file url read))
         (leave (_ "~A: currently not supported~%") repo))))
 
 (define* (call-with-downloaded-file url proc #:optional (error-thunk #f))
   "Fetch URL, store the content in a temporary file and call PROC with that
 file.  Returns the value returned by PROC.  On error call ERROR-THUNK and
 return its value or leave if it's false."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (or (and (url-fetch url temp)
-              (call-with-input-file temp proc))
-         (if error-thunk
-             (error-thunk)
-             (leave (_ "~A: download failed~%") url))))))
+  (proc (http-fetch/cached (string->uri url))))
 
 (define (is-elpa-package? name elpa-pkg-spec)
   "Return true if the string NAME corresponds to the name of the package