From patchwork Mon Feb 10 17:04:18 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Simon Tournier X-Patchwork-Id: 20209 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7ADAD17B3B; Mon, 10 Feb 2020 17:09:34 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id DB0D717AFF for ; Mon, 10 Feb 2020 17:09:33 +0000 (GMT) Received: from localhost ([::1]:36578 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j1CYv-0007lV-8l for patchwork@mira.cbaines.net; Mon, 10 Feb 2020 12:09:33 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:51121) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j1CUb-0003Pq-Gn for guix-patches@gnu.org; Mon, 10 Feb 2020 12:05:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j1CUZ-0004Wd-CC for guix-patches@gnu.org; Mon, 10 Feb 2020 12:05:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:49358) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j1CUY-0004WM-TY for guix-patches@gnu.org; Mon, 10 Feb 2020 12:05:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j1CUY-0004gB-Ng for guix-patches@gnu.org; Mon, 10 Feb 2020 12:05:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#39547] [PATCH] website: Provide JSON sources list used by Software Heritage. Resent-From: zimoun Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 10 Feb 2020 17:05:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 39547 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 39547@debbugs.gnu.org Cc: zimoun X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.158135427717951 (code B ref -1); Mon, 10 Feb 2020 17:05:02 +0000 Received: (at submit) by debbugs.gnu.org; 10 Feb 2020 17:04:37 +0000 Received: from localhost ([127.0.0.1]:55331 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j1CU6-0004fP-BK for submit@debbugs.gnu.org; Mon, 10 Feb 2020 12:04:37 -0500 Received: from lists.gnu.org ([209.51.188.17]:46211) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1j1CU2-0004fG-J4 for submit@debbugs.gnu.org; Mon, 10 Feb 2020 12:04:31 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:50178) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j1CTz-0002oJ-VK for guix-patches@gnu.org; Mon, 10 Feb 2020 12:04:29 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j1CTx-0003q8-Me for guix-patches@gnu.org; Mon, 10 Feb 2020 12:04:27 -0500 Received: from mail-wr1-x443.google.com ([2a00:1450:4864:20::443]:46027) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j1CTx-0003nL-Ad for guix-patches@gnu.org; Mon, 10 Feb 2020 12:04:25 -0500 Received: by mail-wr1-x443.google.com with SMTP id g3so7627938wrs.12 for ; Mon, 10 Feb 2020 09:04:24 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=mosk8DvAhv8UbhMVFP1f25338vyV0ob4vfrXDnT2JP0=; b=ZMs2j6li/XQfyEvlWjtd81YfQuHGbg7Zx2BQYKLMOXp5AWZux/Yojtmvl6llUMytYX jxiRx+ImUfmz9T+jaFBO4YqLWULp5oTmkapEpl1Ll5vYgkvggYJ09kzOJMnHs3r0Aab2 0gABV2Ovjv/ZpNaBU0jh2FF8A1mnVa5OVbFVm2jsjj2sFbZ+7EIgdShQ3It7/RA0fZM8 EXshxED1U3qFLCzi07798VPNkycLFdRHkg0g1S2fft816BMDWS8N6Pot7/nvF/yd9CDE Jz7Dh4Qi09RD+o7edZPaSCcPOkV+RPE7upR/7S+0l1/QZ8T/Iid+7+iKYoaH99v47QsV YEyw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=mosk8DvAhv8UbhMVFP1f25338vyV0ob4vfrXDnT2JP0=; b=g0LYY5VhaTEonK8xxUW/gyVySNbDqRJ2EuFwhv/q/3XcLKziMwn2hbKetcbNkMWs8v 1Sxc7C/RPAynmseypEUcgGCXBzYPk9jZECEmA21haH1SkA1wf2ZDMRg1l3CZD+Bwv7NW zndWak1KfGOul0G7gX77DYerPH2gZ4UvBYv0NPkOnHtc70AULdX5/Zpj1Y3Afc5RiFU3 VfakgGV9S7VIaDFtq8B668VF+k0zN+5LK5DyaOUulfCslk3yXEnP/0zhPn4ey64O17aR qRDi0BscznQ53blPj0pyLhR9MqFsfTj9aB2GT/Wb+KzzRZQKn8cnQBU8uEzUHGTEr/TV roSA== X-Gm-Message-State: APjAAAXPia6GDx4ibxi4+a97CYQ05Qa5ocdWJtlvqH4sZFfEAyItFIs5 aHFGq1SmQubn/+PvPOQcIL3v8kq+ X-Google-Smtp-Source: APXvYqxyCxu7xSwZhGX1eSqXrH00JJcblIvBE1EZ7lz23gPNIGFzoEuIR9XvDnFnU/931WFjKToJ/Q== X-Received: by 2002:adf:f3d0:: with SMTP id g16mr3102866wrp.2.1581354262796; Mon, 10 Feb 2020 09:04:22 -0800 (PST) Received: from pfiuh02.univ-paris-diderot.fr ([193.48.40.241]) by smtp.gmail.com with ESMTPSA id f127sm2870wma.4.2020.02.10.09.04.21 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 10 Feb 2020 09:04:22 -0800 (PST) From: zimoun Date: Mon, 10 Feb 2020 18:04:18 +0100 Message-Id: <20200210170418.32076-1-zimon.toutoune@gmail.com> X-Mailer: git-send-email 2.23.0 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Format discussed here . * website/apps/packages/builder.scm (sources-json-builder): New procedure. --- website/apps/packages/builder.scm | 62 +++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm index 9dc44c9..5279096 100644 --- a/website/apps/packages/builder.scm +++ b/website/apps/packages/builder.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2019 Nicolò Balzarotti +;;; Copyright © 2020 Simon Tournier ;;; ;;; Initially written by sirgazil ;;; who waives all copyright interest on this file. @@ -37,6 +38,8 @@ #:use-module (haunt page) #:use-module (haunt utils) #:use-module (srfi srfi-1) + #:use-module ((web uri) #:select (string->uri uri->string uri-scheme)) + #:use-module ((guix build download) #:select (maybe-expand-mirrors)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) @@ -70,6 +73,7 @@ (flatten (list (index-builder) + (sources-json-builder) (packages-json-builder) (packages-builder) (package-list-builder)))) @@ -84,6 +88,64 @@ ;; Maximum number of packages shown on /packages. 30) +(define (sources-json-builder) + "Return a JSON page listing all the sources." + (define (origin->json origin) + (define method + (origin-method origin)) + + (define uri ;represented as string + (origin-uri origin)) + + (define (mirror->url uri) + (uri->string (car (maybe-expand-mirrors uri %mirrors)))) + + (define (resolve urls) + (let* ((url (car urls)) + (uri (string->uri url)) + (rest (cdr urls))) + (case (uri-scheme uri) + ((mirror) (mirror->url uri)) + ((http) url) + ((https) url) + (else + (if (null? rest) + url + (resolve rest)))))) + + `((type . ,(cond ((eq? url-fetch method) 'url) + ((eq? git-fetch method) 'git) + ((eq? svn-fetch method) 'svn) + (else #nil))) + ,@(cond ((eq? url-fetch method) + `(("url" . ,(match uri + ((? string? url) (mirror->url (string->uri url))) + ((urls ...) (resolve urls)))))) + ((eq? git-fetch method) + `(("git_url" . ,(git-reference-url uri)))) + ((eq? svn-fetch method) + `(("svn_url" . ,(svn-reference-url uri)))) + (else '())) + ,@(if (eq? method git-fetch) + `(("git_ref" . ,(git-reference-commit uri))) + '()) + ,@(if (eq? method svn-fetch) + `(("svn_revision" . ,(svn-reference-revision + uri))) + '()))) + + (define (package->json package) + `(,@(if (origin? (package-source package)) + (origin->json (package-source package)) + `(("type" . "no-origin") + ("name" . ,(package-name package)))))) + + (make-page "sources.json" + `(("sources" . ,(list->vector (map package->json (all-packages)))) + ("version" . "1")) + scm->json)) + + (define (packages-json-builder) "Return a JSON page listing all packages." (define (origin->json origin)