From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id WB/rM3Ds2GCKdwEAgWs5BA (envelope-from ) for ; Sun, 27 Jun 2021 23:24:00 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id GAuZL3Ds2GBCUQAAB5/wlQ (envelope-from ) for ; Sun, 27 Jun 2021 21:24:00 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id CE6E41F906 for ; Sun, 27 Jun 2021 23:23:59 +0200 (CEST) Received: from localhost ([::1]:39078 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lxcFy-0000uC-Rx for larch@yhetil.org; Sun, 27 Jun 2021 17:23:58 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:39792) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lxcFm-0000u1-SC for guix-devel@gnu.org; Sun, 27 Jun 2021 17:23:46 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:44144) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lxcFm-0003er-8x; Sun, 27 Jun 2021 17:23:46 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42502 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lxcFl-00082u-WE; Sun, 27 Jun 2021 17:23:46 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: guix-devel Subject: Guix Data Service client module X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 9 Messidor an 229 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sun, 27 Jun 2021 23:23:43 +0200 Message-ID: <87czs7ypb4.fsf@inria.fr> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: "Guix-devel" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1624829039; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=hlAi+M+h2snP4yJBkayObkFp6n3011gNym0hRiZ/LZM=; b=F/xNPGo5ueZPVqaSZ67ntqnmbn23tQQ8A/ienXRfmeUwnV8h50RwqRKB9HMNPGJIAX5zRp HUl1xSStaGZccd3U43owIC3UJjUuy0zQ/eFVYGfh53lTihq6b7IxPctNvEjacTKIgFewFN 1jE6MO9mSNL+P2mKnxNG+9mLZt03DIb/+CGR46Ox8idkUUc1G0VSIgK6oIEckrY4QYiLv4 5qpHoUrrVn2YgDTIwAt46Z/PSoGSrAyo++4ph7hr9cLNEn8fjvxfhMyFfzsoKLq429t7SF HO3a58B2IG4p3kKRbcholuynVkwaTqucpvmNRGtRiydo9gipavpiVeNP163aCA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1624829039; a=rsa-sha256; cv=none; b=C+e9pqCJxSCqUIXtgyFhCv5IMFaUot7vwYwAfxbFP04AwOj1Zd1pTFtv6YnKJwA5p8veiK voB5wuItyvHjvWSW71gcDfhpxpnU2y2095J751j9sOFoKiWEDGyF4/23dwyM1gSk/xzAAV SUymBoEBZ/IzspdVDRVNiG6yEzXTv9JiNmR4XyuRjbxJXRdjxTzi4+8THVomQdK71Mb4JD MObA2UJVwnMW4VLMX0/XljLWzRAzarmIl18f6I79uHvCec66YRpPVXaSjk0HonhLqKbSpI z5JwqSUm5amfcF4gDSngf70ssL6TkOoCpRwdMhk58VgeAn5G7EOloTbx185wRw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Spam-Score: -0.43 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Queue-Id: CE6E41F906 X-Spam-Score: -0.43 X-Migadu-Scanner: scn1.migadu.com X-TUID: UhID/si9Jyox --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Guix! Here=E2=80=99s a client module for the Guix Data Service, allowing you to a= ccess a subset of the Guix Data Service interfaces from the comfort of your REPL. I had it sitting in my source tree for a while and Chris sent me an impressive shell one-liner that made me want to try from Scheme: wget "https://data.guix-patches.cbaines.net/revision/47f85c53d954f857b45c= ebefee27ec512d917484/lint-warnings.json?locale=3Den_US.UTF-8&linter=3Dinput= -labels&field=3Dlinter&field=3Dmessage&field=3Dlocation" -O - | jq -r '.lin= t_warnings | .[] | .package.name' | sort | uniq | wc -l Turns out we can do the same in two long lines of Scheme! --8<---------------cut here---------------start------------->8--- scheme@(guix data-service)> (define s (open-data-service "https://data.guix= -patches.cbaines.net")) scheme@(guix data-service)> (length (delete-duplicates (map lint-warning-pa= ckage (revision-lint-warnings s "47f85c53d954f857b45cebefee27ec512d917484" = "input-labels")))) $6 =3D 3560 --8<---------------cut here---------------end--------------->8--- (That counts the number of packages at that revision that have one or more warnings from the new =E2=80=98input-labels=E2=80=99 lint checker.) We can do other things, such as browsing package versions: --8<---------------cut here---------------start------------->8--- scheme@(guix data-service)> (define s (open-data-service "https://data.guix= .gnu.org")) scheme@(guix data-service)> (package-version-branches (car (package-version= s (lookup-package s "emacs")))) $9 =3D (#< name: "master" repository-id: 1>) scheme@(guix data-service)> (package-version-history s (car $9) "emacs") $10 =3D (#< version: "27.2" first-revision: #< commit: "cc33f50d0e2a7835e99913226cb4c4b0e9e961ae" date: #> last-revision: #< commit: "364b56124b88398c199aacbfd4fdf= c9a1583e634" date: #>> #< version= : "27.1" first-revision: #< commit: "36a09d185343375a5cba37043187= 0f9c4435d623" date: #> last-revision: #< commit= : "ac29d37e2ffd7a85adfcac9be4d5bce018289bec" date: #>> #<= version: "26.3" first-revision: #< commit= : "43412ab967ee00789fe933f916d804aed9961c57" date: #> las= t-revision: #< commit: "bf19d5e4b26a2e38fe93a45f9341e14476ea5f82"= date: #>> #< version: "26.2" fir= st-revision: #< commit: "5069baedb8a902c3b1ea9656c11471658a1de56b= " date: #> last-revision: #< commit: "02c61278f= 1327d403f072f42e6b92a1dc62fc93a" date: #>> #< version: "26.1" first-revision: #< commit: "897f303d2= fa61497a931cf5fcb43349eb5f44c14" date: #> last-revision: #= < commit: "ee6c4b62b88640f3828cf73a30377124e16cb95f" date: #>>) --8<---------------cut here---------------end--------------->8--- Now all we need to do is plug it into the right tools and enjoy! Ludo=E2=80=99. --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=data-service.scm Content-Transfer-Encoding: quoted-printable Content-Description: the module ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2021 Ludovic Court=C3=A8s ;;; ;;; 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 . (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)) (define-json-mapping make-repository repository? json->repository (id repository-id) (label repository-label) (url repository-url) (branches repository-branches "branches" (const 'not-implemented))) ;FIXME: another kind of bran= ch! (define-json-mapping make-branch branch? json->branch (name branch-name) (repository-id branch-repository-id "git_repository_id")) (define-json-mapping 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 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 make-revision revision? json->revision (commit revision-commit) (date revision-date "datetime" string->date*)) (define-json-mapping 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 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 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 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 socket uri) data-service? (socket data-service-socket) (uri data-service-uri)) (define (open-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 (=3D 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 (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 (package-version-history service branch package) "Return a list of package version ranges for PACKAGE, a string, on BRANCH= , a 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=3D" linte= r) "")))))) (map json->lint-warning (vector->list (assoc-ref result "lint_warnings"))))) --=-=-=--