summaryrefslogtreecommitdiff
path: root/guix/swh.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/swh.scm')
-rw-r--r--guix/swh.scm43
1 files changed, 42 insertions, 1 deletions
diff --git a/guix/swh.scm b/guix/swh.scm
index b5c800011d..922d781a7b 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -55,6 +55,11 @@
visit-number
visit-snapshot
+ snapshot?
+ snapshot-id
+ snapshot-branches
+ lookup-snapshot-branch
+
branch?
branch-name
branch-target
@@ -183,6 +188,12 @@ Software Heritage."
(ref 10))))))
str)) ;oops!
+(define (maybe-null proc)
+ (match-lambda
+ ((? null?) #f)
+ ('null #f)
+ (obj (proc obj))))
+
(define string*
;; Converts "string or #nil" coming from JSON to "string or #f".
(match-lambda
@@ -287,6 +298,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
;; <https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
(define-json-mapping <snapshot> make-snapshot snapshot?
json->snapshot
+ (id snapshot-id)
(branches snapshot-branches "branches" json->branches))
;; This is used for the "branches" field of snapshots.
@@ -316,10 +328,13 @@ FALSE-IF-404? is true, return #f upon 404 responses."
(target-url release-target-url "target_url"))
;; <https://archive.softwareheritage.org/api/1/revision/359fdda40f754bbf1b5dc261e7427b75463b59be/>
+;; Note: Some revisions, such as those for "nixguix" origins (e.g.,
+;; <https://archive.softwareheritage.org/api/1/revision/b8dbc65475bbedde8e015d4730ade8864c38fad3/>),
+;; have their 'date' field set to null.
(define-json-mapping <revision> make-revision revision?
json->revision
(id revision-id)
- (date revision-date "date" string->date*)
+ (date revision-date "date" (maybe-null string->date*))
(directory revision-directory)
(directory-url revision-directory-url "directory_url"))
@@ -426,6 +441,32 @@ available."
(call (swh-url (visit-snapshot-url visit))
json->snapshot)))
+(define (snapshot-url snapshot branch-count first-branch)
+ "Return the URL of SNAPSHOT such that it contains information for
+BRANCH-COUNT branches, starting at FIRST-BRANCH."
+ (string-append (swh-url "/api/1/snapshot" (snapshot-id snapshot))
+ "?branches_count=" (number->string branch-count)
+ "&branches_from=" (uri-encode first-branch)))
+
+(define (lookup-snapshot-branch snapshot name)
+ "Look up branch NAME on SNAPSHOT. Return the branch, or return #f if it
+could not be found."
+ (or (find (lambda (branch)
+ (string=? (branch-name branch) name))
+ (snapshot-branches snapshot))
+
+ ;; There's no API entry point to look up a snapshot branch by name.
+ ;; Work around that by using the paginated list of branches provided by
+ ;; the /api/1/snapshot API: ask for one branch, and start pagination at
+ ;; NAME.
+ (let ((snapshot (call (snapshot-url snapshot 1 name)
+ json->snapshot)))
+ (match (snapshot-branches snapshot)
+ ((branch)
+ (and (string=? (branch-name branch) name)
+ branch))
+ (_ #f)))))
+
(define (branch-target branch)
"Return the target of BRANCH, either a <revision> or a <release>."
(match (branch-target-type branch)