From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id 4BVwMGZQcGbWrgAAqHPOHw:P1 (envelope-from ) for ; Mon, 17 Jun 2024 15:04:06 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0.migadu.com with LMTPS id 4BVwMGZQcGbWrgAAqHPOHw (envelope-from ) for ; Mon, 17 Jun 2024 17:04:06 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=inria.fr header.s=dc header.b=vVTU6UmP; dmarc=pass (policy=none) header.from=inria.fr; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1718636646; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=F9VKKu+dEUesl+3uIVXrXVx7N6kinxmTlq46pqaaXLs=; b=UTw40IDnMg+tIx/DfFptkKAUT3LfZbs8tGBGBtVakE8POPDbpLoOC5I9Fvsr0f9Cxh0pXJ au3YahSWWFWFnlO85ABCqPZMqU8hxn+qjqk8l1nqlFJWdL/sQeELuuvs1EVyNn6VgVJr8b Z42tNIfGEJovRWdQICItbJn/GlA30mNvdcWi2Ow5W4kNpvOzHc7vk6FA5+6sajp2HTSER2 NGgsJ+jGFKJIdaN0tM3wurMwoRXWZbL3/U/6VgrZf29W6r7icAtltJrp46JbQ4UaDtIePM g7wxsRC7tkXSAnxdhUeSWyv1y+wp41A+YEnxRpH/FhcagxN9luCLceionEHpnA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1718636646; a=rsa-sha256; cv=none; b=Ijv4KSwVe7KfWpe7g6P5i5fohgHY117HSnfdBWJH8pCJdo/OSFVa8zVay2HvuyETP+E7NQ KTu/VbaI59M1R9y4hav98I5Jxfz4m3GraRl5XkvEsMV2ReY3kwWy3Sjj4PVR1vD92iEotq 8HHzmdYXvvOgpaGrzwJjBxm+RtZyzw5Ah3RpEmLMC336X5xUhS0sB+Iu1ZULkA9ok58FOZ 48ptUPAKhBNEwt16YYereDQJWS2tFrIHxrA8C+SbBRZRxtDtLBif9ErMaeznnaIm/QNYrT KjL9rU8MtBz2jVBxFvyvPLaxumFRrXLF6sQB08lXNWTsAz36YVJo3yKEGi3gfg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=inria.fr header.s=dc header.b=vVTU6UmP; dmarc=pass (policy=none) header.from=inria.fr; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" 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 7CCEF61C48 for ; Mon, 17 Jun 2024 17:04:06 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sJDtk-0007V1-C9; Mon, 17 Jun 2024 11:03:56 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sJDti-0007Ue-Mz for guix-devel@gnu.org; Mon, 17 Jun 2024 11:03:54 -0400 Received: from mail3-relais-sop.national.inria.fr ([192.134.164.104]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sJDtg-0002i9-Fb for guix-devel@gnu.org; Mon, 17 Jun 2024 11:03:54 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=inria.fr; s=dc; h=from:to:cc:subject:date:message-id:mime-version: content-transfer-encoding; bh=F9VKKu+dEUesl+3uIVXrXVx7N6kinxmTlq46pqaaXLs=; b=vVTU6UmPZ3+GKWqdFLcLuVjmrVH7hbWwuhAZeH4O3W64ZfYuDMQRZ0N1 JFqLaDtBLOK3KTThKXaiXXF5NmTPQVUJ99FoyPE/xk9/mh6TNunhcRRIN 5NeVkQdZJxtUTCm7JP2fEa4pP09+sLP6M7ZzGLjBOm2Vr276lUkw1f5f8 I=; X-IronPort-AV: E=Sophos;i="6.08,244,1712613600"; d="scan'208";a="89905882" Received: from unknown (HELO guix-A102.bordeaux.inria.fr) ([193.50.110.191]) by mail3-relais-sop.national.inria.fr with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 17 Jun 2024 17:03:51 +0200 From: Romain GARBAGE To: guix-devel@gnu.org Cc: ludovic.courtes@inria.fr, Romain GARBAGE Subject: [PATCH Cuirass v2] cuirass: Fix handling of SPECIFICATION-NAME. Date: Mon, 17 Jun 2024 17:02:42 +0200 Message-ID: <20240617150242.18491-1-romain.garbage@inria.fr> X-Mailer: git-send-email 2.45.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=192.134.164.104; envelope-from=romain.garbage@inria.fr; helo=mail3-relais-sop.national.inria.fr X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.29 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-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Spam-Score: -7.36 X-Spam-Score: -7.36 X-Migadu-Queue-Id: 7CCEF61C48 X-Migadu-Scanner: mx11.migadu.com X-TUID: AUzBFTHQsQSa Fixes a regression introduced in 1da873b0e23eceb3c239dd6dc6781debf23bec63, where the NAME field of the SPECIFICATION record type is forced to be a symbol as stated by the documentation. * src/cuirass/base.scm (jobset-registry): Handle SPECIFICATION-NAME as a symbol. * src/cuirass/http.scm (body->specification, specification->json-object, url-handler): Handle SPECIFICATION-NAME as a symbol. * src/cuirass/templates.scm (specifications-table, specification-edit): Fix template generation. --- src/cuirass/base.scm | 4 ++-- src/cuirass/http.scm | 28 +++++++++++++++------------- src/cuirass/templates.scm | 21 +++++++++++---------- 3 files changed, 28 insertions(+), 25 deletions(-) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 86d2f97..507be5f 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -857,7 +857,7 @@ POLLING-PERIOD seconds." ((_ . actor) actor))) (loop registry)) (`(update ,spec) - (let ((name (string->symbol (specification-name spec)))) + (let ((name (specification-name spec))) (match (vhash-assq name registry) (#f (log-error "cannot update non-existent spec '~s'" name)) @@ -877,7 +877,7 @@ POLLING-PERIOD seconds." #:polling-period period)) (name (specification-name spec))) (log-info "registering new jobset '~a'" name) - (loop (vhash-consq (string->symbol name) monitor + (loop (vhash-consq name monitor registry)))) ((_ . monitor) (log-info "jobset '~a' was already registered" diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 48c506c..44d98d4 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -191,7 +191,7 @@ a record." ((mastodon? notif) `((type . mastodon))))) - `((name . ,(specification-name spec)) + `((name . ,(symbol->string (specification-name spec))) (build . ,(match (specification-build spec) ((? symbol? subset) subset) @@ -439,7 +439,8 @@ into a specification record and return it." ((key . param) (and (eq? key field) param))) params))) - (name (assq-ref params 'name)) + (name (string->symbol + (assq-ref params 'name))) (build (string->symbol (assq-ref params 'build))) (build-params (or (and (assq-ref params 'param-select) @@ -458,7 +459,7 @@ into a specification record and return it." param))))))) (channels (map (lambda (name url branch) (channel - (name (string->symbol name)) + (name name) (url url) (branch branch))) (filter-field 'channel-name) @@ -743,7 +744,7 @@ bogus reply is received, return DEFAULT." (respond-json-with-error 400 "Jobset already exists.")))) ;; Accepted or rejected merge requests receive the same treatment. ((or "close" "merge") - (let ((spec-name (symbol->string (specification-name spec)))) + (let ((spec-name (specification-name spec))) (if (db-get-specification spec-name) (begin (db-remove-specification spec-name) @@ -760,7 +761,7 @@ bogus reply is received, return DEFAULT." ;; treated the same way: the jobset is reevaluated. ;; XXX: Copied and adapted from "/jobset//hook/evaluate. ("update" - (let ((spec-name (symbol->string (specification-name spec)))) + (let ((spec-name (specification-name spec))) (if (db-get-specification spec-name) (if (call-bridge `(trigger-jobset ,(specification-name spec)) bridge) @@ -817,7 +818,7 @@ bogus reply is received, return DEFAULT." (build-outputs old-outputs) (notifications old-notifications))) - (unless (call-bridge `(update-jobset ,(string->symbol name)) + (unless (call-bridge `(update-jobset ,name) bridge) (log-error "cannot notify bridge of modification of jobset '~a'" name)) @@ -837,7 +838,7 @@ bogus reply is received, return DEFAULT." #:body "")) (('GET "admin" "specifications" "activate" name) - (if (call-bridge `(activate-jobset ,(string->symbol name)) + (if (call-bridge `(activate-jobset ,name) bridge) (let ((location (string-append "/jobset/" name))) (respond @@ -1180,7 +1181,8 @@ bogus reply is received, return DEFAULT." (respond-dashboard-not-found id)))) (('GET "jobset" name) (respond-html - (let* ((evaluation-id-max (db-get-evaluations-id-max name)) + (let* ((name (string->symbol name)) + (evaluation-id-max (db-get-evaluations-id-max name)) (evaluation-id-min (db-get-evaluations-id-min name)) (params (request-parameters request)) (border-high (assq-ref params 'border-high)) @@ -1192,13 +1194,13 @@ bogus reply is received, return DEFAULT." (absolute-summary (db-get-evaluations-absolute-summary evaluations)) (active? - (call-bridge `(active-jobset? ,(string->symbol name)) + (call-bridge `(active-jobset? ,name) bridge #t)) (last-updates - (call-bridge `(jobset-last-update-times ,(string->symbol name)) + (call-bridge `(jobset-last-update-times ,name) bridge))) (html-page - (string-append "Jobset " name) + (string-append "Jobset " (symbol->string name)) (evaluation-info-table name evaluations evaluation-id-min @@ -1210,7 +1212,7 @@ bogus reply is received, return DEFAULT." #:last-update-times last-updates) `(((#:name . ,name) - (#:link . ,(string-append "/jobset/" name)))))))) + (#:link . ,(string-append "/jobset/" (symbol->string name))))))))) (('GET "eval" "latest") (let* ((params (request-parameters request)) @@ -1405,7 +1407,7 @@ bogus reply is received, return DEFAULT." (let* ((spec (db-get-specification spec)) (name (and spec (specification-name spec)))) (if spec - (if (call-bridge `(trigger-jobset ,(string->symbol name)) + (if (call-bridge `(trigger-jobset ,name) bridge) (respond-json (scm->json-string `((jobset . ,name)))) (begin diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 54a10c1..d49c868 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -378,8 +378,8 @@ system whose names start with " (code "guile-") ":" (br) (td (@ (class "column-name")) (a (@ (href "/jobset/" - ,(specification-name spec))) - ,(specification-name spec))) + ,(symbol->string (specification-name spec)))) + ,(symbol->string (specification-name spec)))) (td (@ (class "column-build")) ,(match (specification-build spec) @@ -422,11 +422,11 @@ system whose names start with " (code "guile-") ":" (br) (style "vertical-align: middle")) ,@(let* ((summary (and=> (spec->latest-eval-ok - (specification-name spec)) + (symbol->string (specification-name spec))) eval-summary)) (last-eval (spec->latest-eval - (specification-name spec))) + (symbol->string (specification-name spec)))) (last-eval-status-ok? (and last-eval (<= (evaluation-current-status last-eval) @@ -455,7 +455,7 @@ system whose names start with " (code "guile-") ":" (br) (else '())))) (td (@ (class "column-action")) - ,@(let* ((name (specification-name spec)) + ,@(let* ((name (symbol->string (specification-name spec))) (dashboard-name (string-append "Dashboard " name))) `((a (@ (href "/eval/latest/dashboard?spec=" @@ -468,10 +468,10 @@ system whose names start with " (code "guile-") ":" (br) ,(let ((id (string-append "specDropdown-" - (specification-name spec))) + (symbol->string (specification-name spec)))) (name (string-append "Options " - (specification-name spec)))) + (symbol->string (specification-name spec))))) `(div (@ (id ,id) (title ,name) @@ -490,12 +490,12 @@ system whose names start with " (code "guile-") ":" (br) (li (@ (role "menuitem")) (a (@ (class "dropdown-item") (href "/specification/edit/" - ,(specification-name spec))) + ,(symbol->string (specification-name spec)))) " Edit")) (li (@ (role "menuitem")) (a (@ (class "dropdown-item") (href "/admin/specifications/deactivate/" - ,(specification-name spec))) + ,(symbol->string (specification-name spec)))) " Deactivate")))))))) specs))))))) @@ -569,7 +569,8 @@ the existing SPEC otherwise." '("") rest))))))) - (let ((name (and spec (specification-name spec))) + (let ((name (and spec (symbol->string + (specification-name spec)))) (build (and spec (match (specification-build spec) ((? symbol? build) build) ((build _ ...) build)))) -- 2.45.1