* [bug#49482] [PATCH 1/3] substitute: Fix handling of short option "-h".
@ 2021-07-09 8:38 Hartmut Goebel
2021-07-09 8:38 ` [bug#49483] [PATCH 2/3] substitutes: Properly construct URLs Hartmut Goebel
2021-07-09 8:38 ` [bug#49482] [PATCH 3/3] ci: " Hartmut Goebel
0 siblings, 2 replies; 5+ messages in thread
From: Hartmut Goebel @ 2021-07-09 8:38 UTC (permalink / raw)
To: 44906, 49482
The short option was listed in the help-text, but not recognized.
---
guix/scripts/substitute.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 03115ffe44..c044e1d47a 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -777,7 +777,7 @@ default value."
(loop))))))
((or ("-V") ("--version"))
(show-version-and-exit "guix substitute"))
- (("--help")
+ ((or ("-h") ("--help"))
(show-help))
(opts
(leave (G_ "~a: unrecognized options~%") opts))))))
--
2.30.2
^ permalink raw reply related [flat|nested] 5+ messages in thread
* [bug#49483] [PATCH 2/3] substitutes: Properly construct URLs.
2021-07-09 8:38 [bug#49482] [PATCH 1/3] substitute: Fix handling of short option "-h" Hartmut Goebel
@ 2021-07-09 8:38 ` Hartmut Goebel
2021-07-09 8:38 ` [bug#49482] [PATCH 3/3] ci: " Hartmut Goebel
1 sibling, 0 replies; 5+ messages in thread
From: Hartmut Goebel @ 2021-07-09 8:38 UTC (permalink / raw)
To: 44906, 49483
Use relative URIs 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 cache-url ends with a slash.
* guix/substitutes.scm (narinfo-request): Use resolve-uri-reference for
constructing the url.
---
guix/substitutes.scm | 13 ++++++++-----
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/guix/substitutes.scm b/guix/substitutes.scm
index 4987cda165..a5c554acff 100644
--- a/guix/substitutes.scm
+++ b/guix/substitutes.scm
@@ -37,7 +37,8 @@
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download)
#:select ((open-connection-for-uri
- . guix:open-connection-for-uri)))
+ . guix:open-connection-for-uri)
+ resolve-uri-reference))
#:use-module (guix progress)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
@@ -155,10 +156,12 @@ indicates that PATH is unavailable at CACHE-URL."
(define (narinfo-request cache-url path)
"Return an HTTP request for the narinfo of PATH at CACHE-URL."
- (let ((url (string-append cache-url "/" (store-path-hash-part path)
- ".narinfo"))
- (headers '((User-Agent . "GNU Guile"))))
- (build-request (string->uri url) #:method 'GET #:headers headers)))
+ (let* ((base (string->uri cache-url))
+ (ref (build-relative-ref
+ #:path (string-append (store-path-hash-part path) ".narinfo")))
+ (url (resolve-uri-reference ref base))
+ (headers '((User-Agent . "GNU Guile"))))
+ (build-request url #:method 'GET #:headers headers)))
(define (narinfo-from-file file url)
"Attempt to read a narinfo from FILE, using URL as the cache URL. Return #f
--
2.30.2
^ permalink raw reply related [flat|nested] 5+ messages in thread
* [bug#49482] [PATCH 3/3] ci: Properly construct URLs.
2021-07-09 8:38 [bug#49482] [PATCH 1/3] substitute: Fix handling of short option "-h" Hartmut Goebel
2021-07-09 8:38 ` [bug#49483] [PATCH 2/3] substitutes: Properly construct URLs Hartmut Goebel
@ 2021-07-09 8:38 ` Hartmut Goebel
2021-07-15 7:35 ` Mathieu Othacehe
1 sibling, 1 reply; 5+ messages in thread
From: Hartmut Goebel @ 2021-07-09 8:38 UTC (permalink / raw)
To: 44906, 49482
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
^ permalink raw reply related [flat|nested] 5+ messages in thread
* [bug#49482] [PATCH 3/3] ci: Properly construct URLs.
2021-07-09 8:38 ` [bug#49482] [PATCH 3/3] ci: " Hartmut Goebel
@ 2021-07-15 7:35 ` Mathieu Othacehe
2021-07-16 17:55 ` bug#44906: " Hartmut Goebel
0 siblings, 1 reply; 5+ messages in thread
From: Mathieu Othacehe @ 2021-07-15 7:35 UTC (permalink / raw)
To: Hartmut Goebel; +Cc: 44906, 49482
Hello Hartmut,
Thanks for this patchset!
> +(define* (api-url base-url path #:rest query)
> + "Build a proper API url, taking into account BASE_URL's trailing slashes."
s/BASE_URL/BASE-URL/
You could also indicate what is the expect format for query: '("name"
"value") lists.
> + (((_ #f) . rest) (lp rest acc))
> + (((name val) . rest)
> + (lp rest (cons*
> + name "="
> + (if (string? val) (uri-encode val) (number->string val))
What about booleans? False is filtered above but true will throw an
exception.
> + (resolve-uri-reference ref base)))
> +
> +
There's an extra new line here.
> +(define* (json-api-fetch base-url path #:rest query)
> + (json-fetch (apply api-url base-url path query)))
> +
> +
Here also.
Otherwise, it looks nice :)
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#44906: [bug#49482] [PATCH 3/3] ci: Properly construct URLs.
2021-07-15 7:35 ` Mathieu Othacehe
@ 2021-07-16 17:55 ` Hartmut Goebel
0 siblings, 0 replies; 5+ messages in thread
From: Hartmut Goebel @ 2021-07-16 17:55 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 44906, 49482
Hi Mathieu,
thanks for the review. I updated the doc-string, fixed the other parts
and pushed as 3ee0f170c8bd883728d8abb2c2e00f445c13f17d.
> What about booleans? False is filtered above but true will throw an
> exception.
False is used to omit elements from the query-string.
Booleans and other types are not handled, since this low-level function
doesn't know how to convert them into a string to be put into the query.
#t could be "1", "t", "true", depending on the API used.
--
Regards
Hartmut Goebel
| Hartmut Goebel | h.goebel@crazy-compilers.com |
| www.crazy-compilers.com | compilers which you thought are impossible |
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2021-07-16 17:56 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-09 8:38 [bug#49482] [PATCH 1/3] substitute: Fix handling of short option "-h" Hartmut Goebel
2021-07-09 8:38 ` [bug#49483] [PATCH 2/3] substitutes: Properly construct URLs Hartmut Goebel
2021-07-09 8:38 ` [bug#49482] [PATCH 3/3] ci: " Hartmut Goebel
2021-07-15 7:35 ` Mathieu Othacehe
2021-07-16 17:55 ` bug#44906: " Hartmut Goebel
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.