aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-10-12 18:39:45 +0100
committerChristopher Baines <mail@cbaines.net>2019-10-12 18:39:45 +0100
commit116775ad06f70078fb77a836f81ecc19aafe6c04 (patch)
treebeb7e2b2ef6f4e13d20bd36a85d2f2d661bbe121 /guix-data-service
parent30051a3740b41f1a171c64a158b1e915396fa9bb (diff)
downloaddata-service-116775ad06f70078fb77a836f81ecc19aafe6c04.tar
data-service-116775ad06f70078fb77a836f81ecc19aafe6c04.tar.gz
Switch the compare page to use parse-query-parameters
Diffstat (limited to 'guix-data-service')
-rw-r--r--guix-data-service/web/controller.scm134
-rw-r--r--guix-data-service/web/view/html.scm9
2 files changed, 79 insertions, 64 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index e954c75..b958395 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -491,59 +491,77 @@
(define (render-compare mime-types
conn
- base-commit
- base-revision-id
- target-commit
- target-revision-id)
- (let-values
- (((base-packages-vhash target-packages-vhash)
- (package-data->package-data-vhashes
- (package-differences-data conn
- base-revision-id
- target-revision-id))))
- (let* ((new-packages
- (package-data-vhashes->new-packages base-packages-vhash
- target-packages-vhash))
- (removed-packages
- (package-data-vhashes->removed-packages base-packages-vhash
- target-packages-vhash))
- (version-changes
- (package-data-version-changes base-packages-vhash
- target-packages-vhash))
- (lint-warnings-data
- (group-list-by-first-n-fields
- 2
- (lint-warning-differences-data conn
- base-revision-id
- target-revision-id))))
+ query-parameters)
+ (if (any-invalid-query-parameters? query-parameters)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
- `((new-packages . ,(list->vector new-packages))
- (removed-packages . ,(list->vector removed-packages))
- (version-changes . ,(list->vector
- (map
- (match-lambda
- ((name data ...)
- `((name . ,name)
- ,@data)))
- version-changes))))
- #:extra-headers http-headers-for-unchanging-content))
+ '((error . "invalid query"))))
(else
(render-html
- #:sxml (compare base-commit
- target-commit
- (guix-revisions-cgit-url-bases
- conn
- (list base-revision-id
- target-revision-id))
- new-packages
- removed-packages
- version-changes
- lint-warnings-data)
- #:extra-headers http-headers-for-unchanging-content))))))
+ #:sxml (compare
+ query-parameters
+ #f
+ #f
+ #f
+ #f
+ #f))))
+ (let ((base-revision-id (commit->revision-id
+ conn
+ (assq-ref query-parameters 'base_commit)))
+ (target-revision-id (commit->revision-id
+ conn
+ (assq-ref query-parameters 'target_commit))))
+ (let-values
+ (((base-packages-vhash target-packages-vhash)
+ (package-data->package-data-vhashes
+ (package-differences-data conn
+ base-revision-id
+ target-revision-id))))
+ (let* ((new-packages
+ (package-data-vhashes->new-packages base-packages-vhash
+ target-packages-vhash))
+ (removed-packages
+ (package-data-vhashes->removed-packages base-packages-vhash
+ target-packages-vhash))
+ (version-changes
+ (package-data-version-changes base-packages-vhash
+ target-packages-vhash))
+ (lint-warnings-data
+ (group-list-by-first-n-fields
+ 2
+ (lint-warning-differences-data conn
+ base-revision-id
+ target-revision-id))))
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ `((new-packages . ,(list->vector new-packages))
+ (removed-packages . ,(list->vector removed-packages))
+ (version-changes . ,(list->vector
+ (map
+ (match-lambda
+ ((name data ...)
+ `((name . ,name)
+ ,@data)))
+ version-changes))))
+ #:extra-headers http-headers-for-unchanging-content))
+ (else
+ (render-html
+ #:sxml (compare query-parameters
+ (guix-revisions-cgit-url-bases
+ conn
+ (list base-revision-id
+ target-revision-id))
+ new-packages
+ removed-packages
+ version-changes
+ lint-warnings-data)
+ #:extra-headers http-headers-for-unchanging-content))))))))
(define (render-compare/derivations mime-types
conn
@@ -1091,22 +1109,14 @@
(render-derivation conn path)
(render-store-item conn path))))
(('GET "compare")
- (with-base-and-target-commits
- query-parameters conn
- (lambda (base-commit base-revision-id target-commit target-revision-id)
- (if (not (and base-revision-id target-revision-id))
- (render-compare-unknown-commit mime-types
- conn
- base-commit
- base-revision-id
- target-commit
- target-revision-id)
- (render-compare mime-types
- conn
- base-commit
- base-revision-id
- target-commit
- target-revision-id)))))
+ (let* ((parsed-query-parameters
+ (parse-query-parameters
+ request
+ `((base_commit ,(parse-commit conn) #:required)
+ (target_commit ,(parse-commit conn) #:required)))))
+ (render-compare mime-types
+ conn
+ parsed-query-parameters)))
(('GET "compare" "derivations")
(let* ((parsed-query-parameters
(parse-query-parameters
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index c2c79a7..e50b53a 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -1628,13 +1628,18 @@
,(display-store-item-short path))))))
derivation-outputs)))))))))
-(define (compare base-commit
- target-commit
+(define (compare query-parameters
cgit-url-bases
new-packages
removed-packages
version-changes
lint-warnings-data)
+ (define base-commit
+ (assq-ref query-parameters 'base_commit))
+
+ (define target-commit
+ (assq-ref query-parameters 'target_commit))
+
(define query-params
(string-append "?base_commit=" base-commit
"&target_commit=" target-commit))