From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id SDFRF24L6GDbEQEAgWs5BA (envelope-from ) for ; Fri, 09 Jul 2021 10:40:14 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id mAoTE24L6GAWWwAA1q6Kng (envelope-from ) for ; Fri, 09 Jul 2021 08:40:14 +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 CBACF1FB42 for ; Fri, 9 Jul 2021 10:40:13 +0200 (CEST) Received: from localhost ([::1]:35486 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m1m3Q-00023K-QL for larch@yhetil.org; Fri, 09 Jul 2021 04:40:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:41334) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m1m3G-00020z-2t for guix-patches@gnu.org; Fri, 09 Jul 2021 04:40:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46788) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m1m3F-0006Rk-QT for guix-patches@gnu.org; Fri, 09 Jul 2021 04:40:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m1m3F-0000jr-Os for guix-patches@gnu.org; Fri, 09 Jul 2021 04:40:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49482] [PATCH 3/3] ci: Properly construct URLs. Resent-From: Hartmut Goebel Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 Jul 2021 08:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49482 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 44906@debbugs.gnu.org, 49482@debbugs.gnu.org X-Debbugs-Original-To: 44906@debbugs.gnu.org, guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16258199452755 (code B ref -1); Fri, 09 Jul 2021 08:40:01 +0000 Received: (at submit) by debbugs.gnu.org; 9 Jul 2021 08:39:05 +0000 Received: from localhost ([127.0.0.1]:58334 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m1m2L-0000iE-8h for submit@debbugs.gnu.org; Fri, 09 Jul 2021 04:39:05 -0400 Received: from lists.gnu.org ([209.51.188.17]:48658) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m1m2G-0000gt-UZ for submit@debbugs.gnu.org; Fri, 09 Jul 2021 04:39:03 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:41002) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m1m2G-0000Gf-N5 for guix-patches@gnu.org; Fri, 09 Jul 2021 04:39:00 -0400 Received: from mail-out.m-online.net ([2001:a60:0:28:0:1:25:1]:57570) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m1m2D-0005qf-Vf for guix-patches@gnu.org; Fri, 09 Jul 2021 04:39:00 -0400 Received: from frontend01.mail.m-online.net (unknown [192.168.8.182]) by mail-out.m-online.net (Postfix) with ESMTP id 4GLmlz6lsXz1s8Nq; Fri, 9 Jul 2021 10:38:55 +0200 (CEST) Received: from localhost (dynscan1.mnet-online.de [192.168.6.70]) by mail.m-online.net (Postfix) with ESMTP id 4GLmlz3wjJz1qr4T; Fri, 9 Jul 2021 10:38:55 +0200 (CEST) X-Virus-Scanned: amavisd-new at mnet-online.de Received: from mail.mnet-online.de ([192.168.8.182]) by localhost (dynscan1.mail.m-online.net [192.168.6.70]) (amavisd-new, port 10024) with ESMTP id uTiNp5X4guTE; Fri, 9 Jul 2021 10:38:54 +0200 (CEST) Received: from hermia.goebel-consult.de (ppp-188-174-58-132.dynamic.mnet-online.de [188.174.58.132]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mail.mnet-online.de (Postfix) with ESMTPS; Fri, 9 Jul 2021 10:38:54 +0200 (CEST) Received: from thisbe.goebel-consult.de (hermia.goebel-consult.de [192.168.110.7]) by hermia.goebel-consult.de (Postfix) with ESMTP id F1CB56022C; Fri, 9 Jul 2021 10:38:46 +0200 (CEST) From: Hartmut Goebel Date: Fri, 9 Jul 2021 10:38:40 +0200 Message-Id: X-Mailer: git-send-email 2.30.2 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: none client-ip=2001:a60:0:28:0:1:25:1; envelope-from=h.goebel@crazy-compilers.com; helo=mail-out.m-online.net X-Spam_score_int: -25 X-Spam_score: -2.6 X-Spam_bar: -- X-Spam_report: (-2.6 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_NONE=0.001, SPF_NONE=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1625820014; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=TrFCUHdmqpedtEoHMofwSxY0uAWfA8UmqMHSY8D9jnE=; b=B/LI01dWHQ72NYcngKUPKubiYGTW4uXsdiciqmCif7ffwzYx2nwfYBGoffqMUMHJpOEsfT s8NNMYPfZSFDLDlzYOipfUvPsSbNKoiwnhoGahlHGGNXTPaHUZ0ktg1tHy6GGNk0SUxDfq AACJqzkb5nuMGPsWXGrQYfSK7F1HHGV56+giZA4A5ZuxJL9ZJL1Ot9ePhusiqLTZA3ojxo 4FhkHhVq1n3QcIpqKaAbDe0BqhLnPDNpqe9K23CNrd1lxTt4W3BoMprAphBK94ZU020rMY sj4CzxNTGopSKdo5Xr+jfGMsBz4hk0brHT9aSZlXFbOMt/LevpuzGxIRboFDow== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1625820014; a=rsa-sha256; cv=none; b=k2o67V8Z/7A1mM5CYFt2zLqokxrt4saCQo6UpCXgquzX6s3+vKaMDYTLsl1P26wmHakpMo vE0v0jopalWUkDqjY1tbiYgQNBYNhzuHJ7LdXZUC/r534XYXHUeTUNwXMFUMJjSRI3R2mu XsAPokpa3vox7eiQ6LJRc0BeL9w1SS/2B7wnd5MM/Payr6EA2/abtXsOxZ7qSh+k2swggX FcpavqtKp9bnNs+arFB4ejPoS3xhs3m35l6XP+ISJBDLMMcNFHQ3ELnkanJMgRSx5dlW1i 7tfOtXl6vrFayS1PD1hLFHNetKEpNoU8faF26REjwaBRNk4cZK8LpsW4OdNFSA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: 2.60 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: CBACF1FB42 X-Spam-Score: 2.60 X-Migadu-Scanner: scn0.migadu.com X-TUID: 3p1jCaERfAZX Implement a new function "api-url", which constructs URLs using relative URI and "resolve-uri-reference" (which implements the algorithm specified in RFC 3986 section 5.2.2) for building the URL, instead of just appending strings. This avoids issued if the server-url ends with a slash. Since "api-url" uses URI-objects, it makes sense to also construct the query-part of the URL here. For this "api-url" accepts optional key-value-pairs. New function "json-api-fetch" is a wrapper using "api-url". * guix/ci.scm (api-url): New function. (build): Use it. (json-api-fetch): New function. (queued-builds, latest-builds, evaluation, latest-evaluations, evaluation-jobs: Use it. --- guix/ci.scm | 79 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 46 insertions(+), 33 deletions(-) diff --git a/guix/ci.scm b/guix/ci.scm index dde93bbd53..cf39744567 100644 --- a/guix/ci.scm +++ b/guix/ci.scm @@ -20,9 +20,12 @@ (define-module (guix ci) #:use-module (guix http-client) #:use-module (guix utils) + #:use-module ((guix build download) + #:select (resolve-uri-reference)) #:use-module (json) #:use-module (srfi srfi-1) #:use-module (ice-9 match) + #:use-module (web uri) #:use-module (guix i18n) #:use-module (guix diagnostics) #:autoload (guix channels) (channel) @@ -146,16 +149,41 @@ ;; Max number of builds requested in queries. 1000) +(define* (api-url base-url path #:rest query) + "Build a proper API url, taking into account BASE_URL's trailing slashes." + + (define (build-query-string query) + (let lp ((query (or (reverse query) '())) (acc '())) + (match query + (() (string-concatenate acc)) + (((_ #f) . rest) (lp rest acc)) + (((name val) . rest) + (lp rest (cons* + name "=" + (if (string? val) (uri-encode val) (number->string val)) + (if (null? acc) "" "&") + acc)))))) + + (let* ((query-string (build-query-string query)) + (base (string->uri base-url)) + (ref (build-relative-ref #:path path #:query query-string))) + (resolve-uri-reference ref base))) + + (define (json-fetch url) (let* ((port (http-fetch url)) (json (json->scm port))) (close-port port) json)) +(define* (json-api-fetch base-url path #:rest query) + (json-fetch (apply api-url base-url path query))) + + (define* (queued-builds url #:optional (limit %query-limit)) "Return the list of queued derivations on URL." - (let ((queue (json-fetch (string-append url "/api/queue?nr=" - (number->string limit))))) + (let ((queue + (json-api-fetch url "/api/queue" `("nr" ,limit)))) (map json->build (vector->list queue)))) (define* (latest-builds url #:optional (limit %query-limit) @@ -163,28 +191,21 @@ "Return the latest builds performed by the CI server at URL. If EVALUATION is an integer, restrict to builds of EVALUATION. If SYSTEM is true (a system string such as \"x86_64-linux\"), restrict to builds for SYSTEM." - (define* (option name value #:optional (->string identity)) - (if value - (string-append "&" name "=" (->string value)) - "")) - - (let ((latest (json-fetch (string-append url "/api/latestbuilds?nr=" - (number->string limit) - (option "evaluation" evaluation - number->string) - (option "system" system) - (option "job" job) - (option "status" status - number->string))))) + (let ((latest (json-api-fetch + url "/api/latestbuilds" + `("nr" ,limit) + `("evaluation" ,evaluation) + `("system" ,system) + `("job" ,job) + `("status" ,status)))) ;; Note: Hydra does not provide a "derivation" field for entries in ;; 'latestbuilds', but Cuirass does. (map json->build (vector->list latest)))) (define (evaluation url evaluation) "Return the given EVALUATION performed by the CI server at URL." - (let ((evaluation (json-fetch - (string-append url "/api/evaluation?id=" - (number->string evaluation))))) + (let ((evaluation + (json-api-fetch url "/api/evaluation" `("id" ,evaluation)))) (json->evaluation evaluation))) (define* (latest-evaluations url @@ -192,16 +213,10 @@ string such as \"x86_64-linux\"), restrict to builds for SYSTEM." #:key spec) "Return the latest evaluations performed by the CI server at URL. If SPEC is passed, only consider the evaluations for the given SPEC specification." - (let ((spec (if spec - (format #f "&spec=~a" spec) - ""))) - (map json->evaluation - (vector->list - (json->scm - (http-fetch - (string-append url "/api/evaluations?nr=" - (number->string limit) - spec))))))) + (map json->evaluation + (vector->list + (json-api-fetch + url "/api/evaluations" `("nr" ,limit) `("spec" ,spec))))) (define* (evaluations-for-commit url commit #:optional (limit %query-limit)) "Return the evaluations among the latest LIMIT evaluations that have COMMIT @@ -216,16 +231,14 @@ as one of their inputs." "Return the list of jobs of evaluation EVALUATION-ID." (map json->job (vector->list - (json->scm (http-fetch - (string-append url "/api/jobs?evaluation=" - (number->string evaluation-id))))))) + (json-api-fetch url "/api/jobs" `("evaluation" ,evaluation-id))))) (define (build url id) "Look up build ID at URL and return it. Raise &http-get-error if it is not found (404)." (json->build - (http-fetch (string-append url "/build/" ;note: no "/api" here - (number->string id))))) + (http-fetch (api-url url (string-append "/build/" ;note: no "/api" here + (number->string id)))))) (define (job-build url job) "Return the build associated with JOB." -- 2.30.2