From: "Ludovic Courtès" <ludo@gnu.org>
To: 68741@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>,
"Christopher Baines" <guix@cbaines.net>,
"Josselin Poiret" <dev@jpoiret.xyz>,
"Ludovic Courtès" <ludo@gnu.org>,
"Mathieu Othacehe" <othacehe@gnu.org>,
"Ricardo Wurmus" <rekado@elephly.net>,
"Simon Tournier" <zimon.toutoune@gmail.com>,
"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#68741] [PATCH 2/6] swh: Add bindings for the “ExtID” API.
Date: Fri, 26 Jan 2024 18:25:02 +0100 [thread overview]
Message-ID: <848b0eb1d2ee9d7a31940c9e1867b8decde6ae3f.1706287537.git.ludo@gnu.org> (raw)
In-Reply-To: <cover.1706287537.git.ludo@gnu.org>
This interface was deployed at archive.softwareheritage.org a few days
ago. Our main use case will be looking up directories by “nar-sha256”
hashes.
* guix/swh.scm (<external-id>): New JSON-mapped record type.
(lookup-external-id, lookup-directory-by-nar-hash): New procedures.
* tests/swh.scm (%external-id): New variable.
("lookup-directory-by-nar-hash"): New test.
Change-Id: Ib671c7798aeb6f8132ac78f2b06b9285da8e7bd5
---
guix/swh.scm | 35 +++++++++++++++++++++++++++++++++++
tests/swh.scm | 21 ++++++++++++++++++++-
2 files changed, 55 insertions(+), 1 deletion(-)
diff --git a/guix/swh.scm b/guix/swh.scm
index 4e71bdb045..60e97c6d38 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -78,6 +78,14 @@ (define-module (guix swh)
lookup-revision
lookup-origin-revision
+ external-id?
+ external-id-value
+ external-id-type
+ external-id-version
+ external-id-target
+ lookup-external-id
+ lookup-directory-by-nar-hash
+
content?
content-checksums
content-data-url
@@ -382,6 +390,15 @@ (define-json-mapping <directory-entry> make-directory-entry directory-entry?
(permissions directory-entry-permissions "perms")
(target-url directory-entry-target-url "target_url"))
+;; <https://archive.softwareheritage.org/api/1/extid/doc/>
+(define-json-mapping <external-id> make-external-id external-id?
+ json->external-id
+ (value external-id-value "extid")
+ (type external-id-type "extid_type")
+ (version external-id-version "extid_version")
+ (target external-id-target)
+ (target-url external-id-target-url "target_url"))
+
;; <https://archive.softwareheritage.org/api/1/origin/save/>
(define-json-mapping <save-reply> make-save-reply save-reply?
json->save-reply
@@ -436,6 +453,24 @@ (define (json->directory-entries port)
(map json->directory-entry
(vector->list (json->scm port))))
+(define (lookup-external-id type id)
+ "Return the external ID record for ID, a bytevector, of the given TYPE
+(currently one of: \"bzr-nodeid\", \"hg-nodeid\", \"nar-sha256\",
+\"checksum-sha512\")."
+ (call (swh-url "/api/1/extid" type
+ (string-append "hex:" (bytevector->base16-string id)))
+ json->external-id))
+
+(define* (lookup-directory-by-nar-hash hash #:optional (algorithm 'sha256))
+ "Return the SWHID of a directory---i.e., prefixed by \"swh:1:dir\"---for the
+directory that with the given HASH (a bytevector), assuming nar serialization
+and use of ALGORITHM."
+ ;; example:
+ ;; https://archive.softwareheritage.org/api/1/extid/nar-sha256/base64url:0jD6Z4TLMm5g1CviuNNuVNP31KWyoT_oevfr8TQwc3Y/
+ (and=> (lookup-external-id (string-append "nar-" (symbol->string algorithm))
+ hash)
+ external-id-target))
+
(define (origin-visits origin)
"Return the list of visits of ORIGIN, a record as returned by
'lookup-origin'."
diff --git a/tests/swh.scm b/tests/swh.scm
index a36f951241..e7ced6b50c 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,6 +18,7 @@
(define-module (test-swh)
#:use-module (guix swh)
+ #:use-module (guix base32)
#:use-module (guix tests http)
#:use-module (web response)
#:use-module (srfi srfi-19)
@@ -56,6 +57,16 @@ (define %directory-entries
\"length\": 456,
\"dir_id\": 2 } ]")
+(define %external-id
+ "{ \"extid_type\": \"nar-sha256\",
+ \"extid\":
+\"0b56ba94c2b83b8f74e3772887c1109135802eb3e8962b628377987fe97e1e63\",
+ \"version\": 0,
+ \"target\": \"swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\",
+ \"target_url\":
+\"https://archive.softwareheritage.org/swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\"
+ }")
+
(define-syntax-rule (with-json-result str exp ...)
(with-http-server `((200 ,str))
(parameterize ((%swh-base-url (%local-url)))
@@ -98,6 +109,14 @@ (define-syntax-rule (with-json-result str exp ...)
(directory-entry-length entry)))
(lookup-directory "123"))))
+(test-equal "lookup-directory-by-nar-hash"
+ "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153"
+ (with-json-result %external-id
+ (lookup-directory-by-nar-hash
+ (nix-base32-string->bytevector
+ "0qqygvlpz63phdi2p5p8ncp80dci230qfa3pwds8yfxqqaablmhb")
+ 'sha256)))
+
(test-equal "rate limit reached"
3000000000
(let ((too-many (build-response
--
2.41.0
next prev parent reply other threads:[~2024-01-26 17:26 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-26 17:16 [bug#68741] [PATCH 0/6] Content-addressed downloads from Software Heritage Ludovic Courtès
2024-01-26 17:25 ` [bug#68741] [PATCH 1/6] swh: ‘vault-fetch’ follows redirects Ludovic Courtès
2024-01-26 17:25 ` Ludovic Courtès [this message]
2024-01-26 17:25 ` [bug#68741] [PATCH 3/6] swh: Add ‘swh-download-directory-by-nar-hash’ Ludovic Courtès
2024-01-26 17:25 ` [bug#68741] [PATCH 4/6] lint: archival: Check with ‘lookup-directory-by-nar-hash’ Ludovic Courtès
2024-01-26 17:25 ` [bug#68741] [PATCH 5/6] git-download: Download from SWH by nar hash when possible Ludovic Courtès
2024-01-26 17:25 ` [bug#68741] [PATCH 6/6] swh: Fix docstring of ‘lookup-directory’ Ludovic Courtès
2024-01-26 17:25 ` [bug#68741] [PATCH 0/6] Content-addressed downloads from Software Heritage Ludovic Courtès
2024-02-12 11:23 ` bug#68741: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=848b0eb1d2ee9d7a31940c9e1867b8decde6ae3f.1706287537.git.ludo@gnu.org \
--to=ludo@gnu.org \
--cc=68741@debbugs.gnu.org \
--cc=dev@jpoiret.xyz \
--cc=guix@cbaines.net \
--cc=me@tobias.gr \
--cc=othacehe@gnu.org \
--cc=rekado@elephly.net \
--cc=zimon.toutoune@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).