[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/09: swh: Adjust to new vault API.
From: |
guix-commits |
Subject: |
05/09: swh: Adjust to new vault API. |
Date: |
Fri, 10 Sep 2021 11:31:25 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit ff613c2b68aac539262822490448e637d8f315ba
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Fri Sep 10 11:42:25 2021 +0200
swh: Adjust to new vault API.
Previously the path to query the vault or request cooking of a directory
was /api/1/vault/directory/ID. It is now deprecated in favor if
/api/1/vault/flat/SWHID. This commit adjusts code accordingly and also
prepares for 'git-bare' support.
* guix/swh.scm (vault-url): New procedure.
(query-vault, request-cooking): Make 'kind' optional, and add
#:archive-type.
Use 'vault-url'.
(vault-fetch): Make 'kind' optional and add #:archive-type. Adjust
'query-vault' and 'request-cooking' calls accordingly.
---
guix/swh.scm | 76 +++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 50 insertions(+), 26 deletions(-)
diff --git a/guix/swh.scm b/guix/swh.scm
index 76234b4..3d5d2a4 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -538,35 +538,57 @@ directory entries; if it has type 'file, return its
<content> object."
(path "/api/1/origin/save" type "url" url)
json->save-reply)
-(define-query (query-vault id kind)
- "Ask the availability of object ID and KIND to the vault, where KIND is
-'directory or 'revision. Return #f if it could not be found, or a
-<vault-reply> on success."
- ;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
- ;; There's a single format supported for directories and revisions and for
- ;; now, the "/format" bit of the URL *must* be omitted.
- (path "/api/1/vault" (symbol->string kind) id)
- json->vault-reply)
-
-(define (request-cooking id kind)
- "Request the cooking of object ID and KIND (one of 'directory or 'revision)
-to the vault. Return a <vault-reply>."
- (call (swh-url "/api/1/vault" (symbol->string kind) id)
+(define* (vault-url id kind #:optional (archive-type 'flat))
+ "Return the vault query/cooking URL for ID and KIND. Normally, ID is an
+SWHID and KIND is #f; the deprecated convention is to set ID to a raw
+directory or revision ID and KIND to 'revision or 'directory."
+ ;; Note: /api/1/vault/directory/ID was deprecated in favor of
+ ;; /api/1/vault/flat/SWHID; this procedure "converts" automatically.
+ (let ((id (match kind
+ ('directory (string-append "swh:1:dir:" id))
+ ('revision (string-append "swh:1:rev:" id))
+ (#f id))))
+ (swh-url "/api/1/vault" (symbol->string archive-type) id)))
+
+(define* (query-vault id #:optional kind #:key (archive-type 'flat))
+ "Ask the availability of object ID (an SWHID) to the vault. Return #f if it
+could not be found, or a <vault-reply> on success. ARCHIVE-TYPE can be 'flat
+for a tarball containing a directory, or 'git-bare for a tarball containing a
+bare Git repository corresponding to a revision.
+
+Passing KIND (one of 'directory or 'revision) together with a raw revision or
+directory identifier is deprecated."
+ (call (vault-url id kind archive-type)
+ json->vault-reply))
+
+(define* (request-cooking id #:optional kind #:key (archive-type 'flat))
+ "Request the cooking of object ID, an SWHID. Return a <vault-reply>.
+ARCHIVE-TYPE can be 'flat for a tarball containing a directory, or 'git-bare
+for a tarball containing a bare Git repository corresponding to a revision.
+
+Passing KIND (one of 'directory or 'revision) together with a raw revision or
+directory identifier is deprecated."
+ (call (vault-url id kind archive-type)
json->vault-reply
http-post*))
-(define* (vault-fetch id kind
- #:key (log-port (current-error-port)))
- "Return an input port from which a bundle of the object with the given ID
-and KIND (one of 'directory or 'revision) can be retrieved, or #f if the
-object could not be found.
-
-For a directory, the returned stream is a gzip-compressed tarball. For a
-revision, it is a gzip-compressed stream for 'git fast-import'."
- (let loop ((reply (query-vault id kind)))
+(define* (vault-fetch id
+ #:optional kind
+ #:key
+ (archive-type 'flat)
+ (log-port (current-error-port)))
+ "Return an input port from which a bundle of the object with the given ID,
+an SWHID, or #f if the object could not be found.
+
+ARCHIVE-TYPE can be 'flat for a tarball containing a directory, or 'git-bare
+for a tarball containing a bare Git repository corresponding to a revision."
+ (let loop ((reply (query-vault id kind
+ #:archive-type archive-type)))
(match reply
(#f
- (and=> (request-cooking id kind) loop))
+ (and=> (request-cooking id kind
+ #:archive-type archive-type)
+ loop))
(_
(match (vault-reply-status reply)
('done
@@ -586,7 +608,8 @@ revision, it is a gzip-compressed stream for 'git
fast-import'."
(format log-port "SWH vault: failure: ~a~%"
(vault-reply-progress-message reply))
(format log-port "SWH vault: retrying...~%")
- (loop (request-cooking id kind)))
+ (loop (request-cooking id kind
+ #:archive-type archive-type)))
((and (or 'new 'pending) status)
;; Wait until the bundle shows up.
(let ((message (vault-reply-progress-message reply)))
@@ -601,7 +624,8 @@ requested bundle cooking, waiting for completion...~%"))
;; requests per hour per IP address.)
(sleep (if (eq? status 'new) 60 30))
- (loop (query-vault id kind)))))))))
+ (loop (query-vault id kind
+ #:archive-type archive-type)))))))))
;;;
- branch master updated (eb31966 -> 9875f9b), guix-commits, 2021/09/10
- 02/09: base16: Reduce GC pressure in bytevector->base16-string., guix-commits, 2021/09/10
- 01/09: gnu: llvm-for-rocm: Move to llvm.scm., guix-commits, 2021/09/10
- 04/09: lint: archival: Warn about non-origin sources., guix-commits, 2021/09/10
- 05/09: swh: Adjust to new vault API.,
guix-commits <=
- 03/09: base32: Provide an open-coded 'bit-field'., guix-commits, 2021/09/10
- 06/09: swh: 'swh-download' reports revision lookup failures., guix-commits, 2021/09/10
- 07/09: gnu: racket: fix `raco exe` with non-minimal Racket, guix-commits, 2021/09/10
- 08/09: gnu: racket: suppress build stamp, guix-commits, 2021/09/10
- 09/09: import: elpa: Don't hardcode default branch to 'master'., guix-commits, 2021/09/10