diff options
author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2021-09-06 15:43:04 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-09-06 22:58:12 +0200 |
commit | 153fd217b62a3d57d00f2ce440cf010f5070e886 (patch) | |
tree | 03bd64f9363c53446a3ed643979482d0c27bff90 | |
parent | 63ed618e337a466772aadd6ef3b919b7f04b666d (diff) | |
download | guix-153fd217b62a3d57d00f2ce440cf010f5070e886.tar.gz |
swh: Add 'lookup-snapshot-branch'.
* guix/swh.scm (<snapshot>)[id]: New field. (snapshot-url, lookup-snapshot-branch): New procedures.
-rw-r--r-- | guix/swh.scm | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/guix/swh.scm b/guix/swh.scm index 4d0a647d6f..922d781a7b 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -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) |