[bug#51216] [PATCH 1/1] swh: Allows token from Software Heritage authentication service.

[zimoun]

The token is provided using the environment variable GUIX_SWH_TOKEN.

* guix/swh.scm (swh-token): New variable.
(http-get*, http-post*): Use it.
---
 guix/swh.scm | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/guix/swh.scm b/guix/swh.scm
index 5c41685a24..38a4af723a 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -153,12 +154,30 @@ (define url
       url
       (string-append url "/")))
 
+;; Token from an account to the Software Heritage Authentication service
+;; <https://archive.softwareheritage.org/api/>
+(define swh-token
+  (match (getenv "GUIX_SWH_TOKEN")
+    (#f #f)
+    ((? string-null? s) #f)
+    ((? string? s) (string->symbol s))))
+
 ;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would
 ;; be ignored (<https://bugs.gnu.org/40486>).
 (define* (http-get* uri #:rest rest)
-  (apply http-request uri #:method 'GET rest))
+  (apply http-request uri #:method 'GET
+         #:headers
+         (if swh-token
+             `((authorization . (Bearer ,swh-token)))
+             '())
+         rest))
 (define* (http-post* uri #:rest rest)
-  (apply http-request uri #:method 'POST rest))
+  (apply http-request uri #:method 'POST
+         #:headers
+         (if swh-token
+             `((authorization . (Bearer ,swh-token)))
+             '())
+         rest))
 
 (define %date-regexp
   ;; Match strings like "2014-11-17T22:09:38+01:00" or
-- 
2.32.0