gnu: Add armips.

[jackhill/guix/guix.git] / guix / swh.scm

diff --git a/guix/swh.scm b/guix/swh.scm
index 372e4c8..913f0d1 100644 (file)
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,6 @@
             request-rate-limit-reached?
 
             origin?
-            origin-id
             origin-type
             origin-url
             origin-visits
@@ -127,9 +127,16 @@
   (make-parameter "https://archive.softwareheritage.org"))
 
 (define (swh-url path . rest)
+  ;; URLs returned by the API may be relative or absolute. This has changed
+  ;; without notice before. Handle both cases by detecting whether the path
+  ;; starts with a domain.
+  (define root
+    (if (string-prefix? "/" path)
+      (string-append (%swh-base-url) path)
+      path))
+
   (define url
-    (string-append (%swh-base-url) path
-                   (string-join rest "/" 'prefix)))
+    (string-append root (string-join rest "/" 'prefix)))
 
   ;; Ensure there's a trailing slash or we get a redirect.
   (if (string-suffix? "/" url)
@@ -167,7 +174,8 @@ Software Heritage."
   ;; Converts "string or #nil" coming from JSON to "string or #f".
   (match-lambda
     ((? string? str) str)
-    ((? null?) #f)))
+    ((? null?) #f)                                ;Guile-JSON 3.x
+    ('null #f)))                                  ;Guile-JSON 4.x
 
 (define %allow-request?
   ;; Takes a URL and method (e.g., the 'http-get' procedure) and returns true
@@ -244,10 +252,9 @@ FALSE-IF-404? is true, return #f upon 404 responses."
        docstring
        (call (swh-url components ...) json->value)))))
 
-;; <https://archive.softwareheritage.org/api/1/origin//https://github.com/guix-mirror/guix/get>
+;; <https://archive.softwareheritage.org/api/1/origin/https://github.com/guix-mirror/guix/get>
 (define-json-mapping <origin> make-origin origin?
   json->origin
-  (id origin-id)
   (visits-url origin-visits-url "origin_visits_url")
   (type origin-type)
   (url origin-url))