cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove the HTTP headers from the html module

Browse source 
Given that the headers may be the same, regardless whether it's HTML or JSON
being sent in the body of the response, I think it makes more sense to handle
the headers in the controller.
This commit is contained in:
Christopher Baines 2019-05-18 20:08:34 +01:00
parent ed19764bc3
commit 03faff5da0
2 changed files with 151 additions and 181 deletions
Download patch file Download diff file Expand all files Collapse all files

65
guix-data-service/web/controller.scm
View file

@ -106,8 +106,8 @@
(derivation_count . ,derivation_count)))) (derivation_count . ,derivation_count))))
derivations-counts)))))) derivations-counts))))))
(else (else
(apply render-html (render-html
(view-revision #:sxml (view-revision
commit-hash commit-hash
packages-count packages-count
git-repositories-and-branches git-repositories-and-branches
@ -133,8 +133,8 @@
(render-json (render-json
`((error . "invalid query")))) `((error . "invalid query"))))
(else (else
(apply render-html (render-html
(view-revision-packages commit-hash #:sxml (view-revision-packages commit-hash
query-parameters query-parameters
'() '()
'() '()
@ -204,8 +204,8 @@
'())))) '()))))
packages)))))) packages))))))
(else (else
(apply render-html (render-html
(view-revision-packages commit-hash #:sxml (view-revision-packages commit-hash
query-parameters query-parameters
packages packages
git-repositories git-repositories
@ -251,8 +251,8 @@
(derivation . ,file-name)))) (derivation . ,file-name))))
derivations)))))) derivations))))))
(else (else
(apply render-html (render-html
(view-revision-package-and-version commit-hash #:sxml (view-revision-package-and-version commit-hash
name name
version version
metadata metadata
@ -272,8 +272,8 @@
(render-json (render-json
'((unknown_commit . #t)))) '((unknown_commit . #t))))
(else (else
(apply render-html (render-html
(compare-unknown-commit base-commit #:sxml (compare-unknown-commit base-commit
target-commit target-commit
(if base-revision-id #t #f) (if base-revision-id #t #f)
(if target-revision-id #t #f) (if target-revision-id #t #f)
@ -316,8 +316,8 @@
(version-changes . ,version-changes) (version-changes . ,version-changes)
(derivation-changes . ,derivation-changes)))) (derivation-changes . ,derivation-changes))))
(else (else
(apply render-html (render-html
(compare base-commit #:sxml (compare base-commit
target-commit target-commit
new-packages new-packages
removed-packages removed-packages
@ -346,8 +346,8 @@
(render-json (render-json
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(apply render-html (render-html
(compare/derivations #:sxml (compare/derivations
query-parameters query-parameters
(valid-systems conn) (valid-systems conn)
build-status-strings build-status-strings
@ -393,8 +393,8 @@
(derivations->alist (derivations->alist
target-derivations)))))))) target-derivations))))))))
(else (else
(apply render-html (render-html
(compare/derivations #:sxml (compare/derivations
query-parameters query-parameters
(valid-systems conn) (valid-systems conn)
build-status-strings build-status-strings
@ -436,8 +436,8 @@
(packages . ,(list->vector (packages . ,(list->vector
(package-data-vhash->json target-packages-vhash)))))))) (package-data-vhash->json target-packages-vhash))))))))
(else (else
(apply render-html (render-html
(compare/packages #:sxml (compare/packages
base-commit base-commit
target-commit target-commit
base-packages-vhash base-packages-vhash
@ -456,8 +456,8 @@
(builds (select-builds-with-context-by-derivation-id (builds (select-builds-with-context-by-derivation-id
conn conn
(first derivation)))) (first derivation))))
(apply render-html (render-html
(view-derivation derivation #:sxml (view-derivation derivation
derivation-inputs derivation-inputs
derivation-outputs derivation-outputs
builds))) builds)))
@ -470,8 +470,8 @@
(() (()
#f) #f)
(derivations (derivations
(apply render-html (render-html
(view-store-item filename #:sxml (view-store-item filename
derivations derivations
(map (lambda (derivation) (map (lambda (derivation)
(match derivation (match derivation
@ -502,8 +502,8 @@
(match method-and-path-components (match method-and-path-components
((GET) ((GET)
(apply render-html (render-html
(index #:sxml (index
(map (map
(lambda (git-repository-details) (lambda (git-repository-details)
(cons (cons
@ -521,12 +521,12 @@
(car git-repository-details))))) (car git-repository-details)))))
(all-git-repositories conn))))) (all-git-repositories conn)))))
((GET "builds") ((GET "builds")
(apply render-html (render-html
(view-builds (select-build-stats conn) #:sxml (view-builds (select-build-stats conn)
(select-builds-with-context conn)))) (select-builds-with-context conn))))
((GET "statistics") ((GET "statistics")
(apply render-html (render-html
(view-statistics (count-guix-revisions conn) #:sxml (view-statistics (count-guix-revisions conn)
(count-derivations conn)))) (count-derivations conn))))
((GET "revision" commit-hash) (render-view-revision mime-types ((GET "revision" commit-hash) (render-view-revision mime-types
conn conn
@ -556,8 +556,8 @@
name name
version)) version))
((GET "branches") ((GET "branches")
(apply render-html (render-html
(view-branches #:sxml (view-branches
(all-branches-with-most-recent-commit conn)))) (all-branches-with-most-recent-commit conn))))
((GET "branch" branch-name) ((GET "branch" branch-name)
(let ((parsed-query-parameters (let ((parsed-query-parameters
@ -566,9 +566,8 @@
`((after_date ,parse-datetime) `((after_date ,parse-datetime)
(before_date ,parse-datetime) (before_date ,parse-datetime)
(limit_results ,parse-result-limit #:default 100))))) (limit_results ,parse-result-limit #:default 100)))))
(apply (render-html
render-html #:sxml (if (any-invalid-query-parameters? parsed-query-parameters)
(if (any-invalid-query-parameters? parsed-query-parameters)
(view-branch branch-name parsed-query-parameters '()) (view-branch branch-name parsed-query-parameters '())
(view-branch (view-branch
branch-name branch-name

35
guix-data-service/web/view/html.scm
View file

@ -57,9 +57,8 @@
(define* (layout #:key (define* (layout #:key
(head '()) (head '())
(body '()) (body '())
(title "Guix Data Service") (title "Guix Data Service"))
(extra-headers '())) `((doctype "html")
`(#:sxml ((doctype "html")
(html (html
(head (head
(title ,title) (title ,title)
@ -92,9 +91,7 @@
"Now with even more " (span (@ (class "lambda")) "λ") "! ") "Now with even more " (span (@ (class "lambda")) "λ") "! ")
(p "This is free software. Download the " (p "This is free software. Download the "
(a (@ (href "https://git.cbaines.net/guix/data-service/")) (a (@ (href "https://git.cbaines.net/guix/data-service/"))
"source code here") "."))))) "source code here") "."))))))
#:extra-headers ,extra-headers))
(define* (form-horizontal-control label query-parameters (define* (form-horizontal-control label query-parameters
#:key #:key
@ -202,8 +199,6 @@
(define (index git-repositories-and-revisions) (define (index git-repositories-and-revisions)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -290,8 +285,6 @@
(define (view-statistics guix-revisions-count derivations-count) (define (view-statistics guix-revisions-count derivations-count)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -315,8 +308,6 @@
package-metadata package-metadata
derivations git-repositories) derivations git-repositories)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -405,8 +396,6 @@
(define (view-revision commit-hash packages-count (define (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count) git-repositories-and-branches derivations-count)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -490,8 +479,6 @@
"Home page" "Location" "Licenses"))) "Home page" "Location" "Licenses")))
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -640,8 +627,6 @@
(define (view-branches branches-with-most-recent-commits) (define (view-branches branches-with-most-recent-commits)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -683,8 +668,6 @@
(define (view-branch branch-name query-parameters (define (view-branch branch-name query-parameters
branch-commits) branch-commits)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -746,8 +729,6 @@
(define (view-builds stats builds) (define (view-builds stats builds)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -858,8 +839,6 @@
(define (view-store-item filename derivations derivations-using-store-item-list) (define (view-store-item filename derivations derivations-using-store-item-list)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -902,8 +881,6 @@
(define (view-derivation derivation derivation-inputs derivation-outputs (define (view-derivation derivation derivation-inputs derivation-outputs
builds) builds)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -996,8 +973,6 @@
"&target_commit=" target-commit)) "&target_commit=" target-commit))
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -1194,8 +1169,6 @@
base-derivations base-derivations
target-derivations) target-derivations)
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div
@ -1322,8 +1295,6 @@
"&target_commit=" target-commit)) "&target_commit=" target-commit))
(layout (layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body #:body
`(,(header) `(,(header)
(div (div