Hi there! Sergio Pastor Pérez <[email protected]> skribis:
> Unfortunately I'm quite illiterate with regards to web related > things. Not sure how much it would help, but back in the day¹ I wrote the beginning of a client interface for the Data Service (attached here). Maybe this could serve to build useful tools? Ludo’. ¹ https://lists.gnu.org/archive/html/guix-devel/2021-06/msg00228.html
;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021, 2022 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix data-service) #:use-module (json) #:use-module (web client) #:use-module (web response) #:use-module (web uri) #:use-module ((guix diagnostics) #:select (location)) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) #:use-module (srfi srfi-71) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (ice-9 match) #:export (repository? repository-id repository-label repository-url repository-branches repository-revisions branch? branch-name branch-repository-id package-version? package-version-string package-version-branches package? package-name package-versions revision? revision-commit revision-date processed-revision? processed-revision-data-available? processed-revision-date processed-revision-commit build? build-server-id build-id build-time channel-instance? channel-instance-system channel-instance-derivation channel-instance-builds lint-warning? lint-warning-package lint-warning-package-version lint-warning-message lint-warning-location data-service-url open-data-service lookup-package lookup-repository known-repositories package-version-history revision-channel-instances revision-lint-warnings)) (define-json-mapping <repository> make-repository repository? json->repository (id repository-id) (label repository-label) (url repository-url) (revisions repository-branches "branches" (lambda (vector) ;; XXX: Not quite the same as <revision> since 'name' is ;; missing from <revision> and 'date' is missing from this ;; one. (map json->revision (vector->list vector))))) (define-json-mapping <branch> make-branch branch? json->branch (name branch-name) (repository-id branch-repository-id "git_repository_id")) (define-json-mapping <package-version> make-package-version package-version? json->package-version (string package-version-string "version") (branches package-version-branches "branches" (lambda (vector) (map json->branch (vector->list vector))))) (define-json-mapping <package> make-package package? json->package (name package-name) (versions package-versions "versions" (lambda (vector) (map json->package-version (vector->list vector))))) (define (utc-date date) "Return DATE with its timezone offset zeroed." (make-date (date-nanosecond date) (date-second date) (date-minute date) (date-hour date) (date-day date) (date-month date) (date-year date) 0)) (define (string->date* str) (utc-date (string->date str "~Y-~m-~d ~H:~M:~S"))) ;assume dates are UTC (define-json-mapping <revision> make-revision revision? json->revision (commit revision-commit) (date revision-date "datetime" string->date*)) (define-json-mapping <processed-revision> make-processed-revision processed-revision? json->processed-revision (data-available? processed-revision-data-available? "data_available") (commit processed-revision-commit "commit-hash") (date processed-revision-date "date" string->date*)) (define-json-mapping <package-version-range> make-package-version-range package-version-range? json->package-version-range (version package-version-range-version) (first-revision package-version-range-first-revision "first_revision" json->revision) (last-revision package-version-range-last-revision "last_revision" json->revision)) (define-json-mapping <build> make-build build? json->build (server-id build-server-id "build_server_id") (id build-id "build_server_build_id") (time build-time "timestamp" (lambda (str) (utc-date (string->date str "~Y-~m-~dT~H:~M:~S"))))) (define-json-mapping <channel-instance> make-channel-instance channel-instance? json->channel-instance (system channel-instance-system) (derivation channel-instance-derivation) (builds channel-instance-builds "builds" (lambda (vector) (map json->build (vector->list vector))))) (define (json->location alist) (location (assoc-ref alist "file") (assoc-ref alist "line-number") (assoc-ref alist "column-number"))) (define-json-mapping <lint-warning> make-lint-warning lint-warning? json->lint-warning (package lint-warning-package "package" (lambda (alist) (assoc-ref alist "name"))) (package-version lint-warning-package-version "package" (lambda (alist) (assoc-ref alist "version"))) (message lint-warning-message) (location lint-warning-location "location" json->location)) ;;; ;;; Calling the Guix Data Service. ;;; ;; Connection to an instance of the Data Service. (define-record-type <data-service> (data-service socket uri) data-service? (socket data-service-socket) (uri data-service-uri)) (define data-service-url (make-parameter "https://data.guix.gnu.org";)) (define* (open-data-service #:optional (url (data-service-url))) "Open a connection to the Guix Data Service instance at URL." (let ((uri (string->uri url))) (data-service (open-socket-for-uri uri) uri))) (define (make-data-service-uri service path) (build-uri (uri-scheme (data-service-uri service)) #:host (uri-host (data-service-uri service)) #:port (uri-port (data-service-uri service)) #:path path)) (define (discard port n) "Read N bytes from PORT and discard them." (define bv (make-bytevector 4096)) (let loop ((n n)) (unless (zero? n) (match (get-bytevector-n! port bv 0 (min n (bytevector-length bv))) ((? eof-object?) #t) (read (loop (- n read))))))) (define (call service path) (let* ((uri (make-data-service-uri service path)) (response port (http-get uri #:port (data-service-socket service) #:keep-alive? #t #:headers '((Accept . "application/json")) #:streaming? #t))) (unless (= 200 (response-code response)) (when (response-content-length response) (discard port (response-content-length response))) (throw 'data-service-client-error uri response)) port)) (define (lookup-package service name) "Lookup package NAME and return a package record." (json->package (call service (string-append "/package/" name)))) (define (known-repositories service) "Return the list of repositories known to SERVICE." (map json->repository (let ((data (json->scm (call service "/repositories")))) (vector->list (assoc-ref data "repositories"))))) (define (lookup-repository service id) "Lookup the repository with the given ID, an integer, and return it." (json->repository (call service (string-append "/repository/" (number->string id))))) (define (repository-processed-revisions service repository branch) "Return the list of revisions processed for BRANCH in REPOSITORY." (map json->processed-revision (let ((data (json->scm (call service (string-append "/repository/" (repository-id repository) "/branch/" branch))))) (vector->list (assoc-ref data "revisions"))))) (define (package-version-history service branch package) "Return a list of package version ranges for PACKAGE, a string, on BRANCH, a <branch> record." ;; http://data.guix.gnu.org/repository/1/branch/master/package/emacs.json (map json->package-version-range (let ((result (json->scm (call service (string-append "/repository/" (number->string (branch-repository-id branch)) "/branch/" (branch-name branch) "/package/" package))))) (vector->list (assoc-ref result "versions"))))) (define (revision-channel-instances service commit) "Return the channel instances for COMMIT." (let ((result (json->scm (call service (string-append "/revision/" commit "/channel-instances"))))) (map json->channel-instance (vector->list (assoc-ref result "channel_instances"))))) (define* (revision-lint-warnings service commit #:optional linter) "Return lint warnings for COMMIT. If LINTER is given, only show warnings for the given linter--e.g., 'description'." (let ((result (json->scm (call service (string-append "/revision/" commit "/lint-warnings" (if linter (string-append "?linter=" linter) "")))))) (map json->lint-warning (vector->list (assoc-ref result "lint_warnings")))))
