[bug#53818] [PATCH v2 2/7] http-client: Make 'http-fetch/cached' take '#:headers' argument.

[Xinglu Chen <public@yoctocell.xyz>]

* guix/http-client.scm (http-fetch/cached): Take ‘#:headers’ keyword argument.
---
 guix/http-client.scm | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 10bc278023..058f09852f 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2022 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -283,9 +284,11 @@ (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
                             (write-cache dump-port)
                             (cache-miss (const #t))
                             (log-port (current-error-port))
-                            (timeout 10))
+                            (timeout 10)
+                            (headers '((user-agent . "GNU Guile"))))
   "Like 'http-fetch', return an input port, but cache its contents in
-~/.cache/guix.  The cache remains valid for TTL seconds.
+~/.cache/guix.  The cache remains valid for TTL seconds.  HEADERS is an alist
+of extra HTTP headers.  The cache time will automatically be added to HEADERS, so there is no need to specify it.
 
 Call WRITE-CACHE with the HTTP input port and the cache output port to write
 the data to cache.  Call CACHE-MISS with URI just before fetching data from
@@ -300,8 +303,8 @@ (define cache-time
         (and cache-port
              (stat:mtime (stat cache-port))))
 
-      (define headers
-        `((user-agent . "GNU Guile")
+      (define headers*
+        `(,@headers
           ,@(if cache-time
                 `((if-modified-since
                    . ,(time-utc->date (make-time time-utc 0 cache-time))))
@@ -316,7 +319,7 @@ (define headers
                      (raise c))))
         (let ((port (http-fetch uri #:text? text?
                                 #:log-port log-port
-                                #:headers headers #:timeout timeout)))
+                                #:headers headers* #:timeout timeout)))
           (cache-miss uri)
           (mkdir-p (dirname file))
           (when cache-port
-- 
2.34.1