GNU bug report logs - #51216
[PATCH 0/1] swh: Allows token from Software Heritage authentication service.

Previous Next

Package: guix-patches;

Reported by: zimoun <zimon.toutoune <at> gmail.com>

Date: Thu, 14 Oct 2021 21:33:01 UTC

Severity: normal

Tags: patch

Done: Ludovic Courtès <ludo <at> gnu.org>

Bug is archived. No further changes may be made.

Full log


Message #8 received at 51216 <at> debbugs.gnu.org (full text, mbox):

From: zimoun <zimon.toutoune <at> gmail.com>
To: 51216 <at> debbugs.gnu.org
Cc: zimoun <zimon.toutoune <at> gmail.com>
Subject: [PATCH 1/1] swh: Allows token from Software Heritage authentication
 service.
Date: Thu, 14 Oct 2021 23:33:46 +0200
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 <at> gnu.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
 ;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> 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





This bug report was last modified 3 years and 219 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.