futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

swh: Add 'lookup-snapshot-branch'.

Browse Source 
* guix/swh.scm (<snapshot>)[id]: New field.
(snapshot-url, lookup-snapshot-branch): New procedures.
This commit is contained in:
Ludovic Courtès 2021-09-06 15:43:04 +02:00 committed by Ludovic Courtès
parent 63ed618e33
commit 153fd217b6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
guix/swh.scm
View File

@ -56,7 +56,9 @@
visit-snapshot
snapshot?
snapshot-id
snapshot-branches
lookup-snapshot-branch
branch?
branch-name
@ -296,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.
@ -438,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)