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

Cache the pages which don't really change for a day

Browse source
This commit is contained in:
Christopher Baines 2019-05-18 20:25:34 +01:00
parent 0ca5748c0f
commit d4b23f81c1
1 changed files with 37 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -48,6 +48,14 @@
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
#:export (controller)) #:export (controller))
(define cache-control-default-max-age
(* 60 60 24)) ; One day
(define http-headers-for-unchanging-content
`((cache-control
. (public
(max-age . ,cache-control-default-max-age)))))
(define-syntax-rule (-> target functions ...) (define-syntax-rule (-> target functions ...)
(fold (lambda (f val) (and=> val f)) (fold (lambda (f val) (and=> val f))
target target
@ -104,14 +112,16 @@
`((system . ,system) `((system . ,system)
(target . ,target) (target . ,target)
(derivation_count . ,derivation_count)))) (derivation_count . ,derivation_count))))
derivations-counts)))))) derivations-counts))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (view-revision #:sxml (view-revision
commit-hash commit-hash
packages-count packages-count
git-repositories-and-branches git-repositories-and-branches
derivations-counts)))))) derivations-counts)
#:extra-headers http-headers-for-unchanging-content)))))
(define (texinfo->variants-alist s) (define (texinfo->variants-alist s)
(let ((stexi (texi-fragment->stexi s))) (let ((stexi (texi-fragment->stexi s)))
@ -202,14 +212,16 @@
#() #()
(json-string->scm licenses)))) (json-string->scm licenses))))
'())))) '()))))
packages)))))) packages))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (view-revision-packages commit-hash #:sxml (view-revision-packages commit-hash
query-parameters query-parameters
packages packages
git-repositories git-repositories
show-next-page?))))))) show-next-page?)
#:extra-headers http-headers-for-unchanging-content))))))
(define (render-revision-package mime-types (define (render-revision-package mime-types
conn conn
@ -249,7 +261,8 @@
`((system . ,system) `((system . ,system)
(target . ,target) (target . ,target)
(derivation . ,file-name)))) (derivation . ,file-name))))
derivations)))))) derivations))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (view-revision-package-and-version commit-hash #:sxml (view-revision-package-and-version commit-hash
@ -257,7 +270,8 @@
version version
metadata metadata
derivations derivations
git-repositories)))))) git-repositories)
#:extra-headers http-headers-for-unchanging-content)))))
(define (render-compare-unknown-commit mime-types (define (render-compare-unknown-commit mime-types
conn conn
@ -314,7 +328,8 @@
`((new-packages . ,(list->vector new-packages)) `((new-packages . ,(list->vector new-packages))
(removed-packages . ,(list->vector removed-packages)) (removed-packages . ,(list->vector removed-packages))
(version-changes . ,version-changes) (version-changes . ,version-changes)
(derivation-changes . ,derivation-changes)))) (derivation-changes . ,derivation-changes))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (compare base-commit #:sxml (compare base-commit
@ -322,7 +337,8 @@
new-packages new-packages
removed-packages removed-packages
version-changes version-changes
derivation-changes))))))) derivation-changes)
#:extra-headers http-headers-for-unchanging-content))))))
(define (render-compare/derivations mime-types (define (render-compare/derivations mime-types
conn conn
@ -391,7 +407,8 @@
(target . ((commit . ,target-commit) (target . ((commit . ,target-commit)
(derivations . ,(list->vector (derivations . ,(list->vector
(derivations->alist (derivations->alist
target-derivations)))))))) target-derivations))))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (compare/derivations #:sxml (compare/derivations
@ -399,7 +416,8 @@
(valid-systems conn) (valid-systems conn)
build-status-strings build-status-strings
base-derivations base-derivations
target-derivations))))))))) target-derivations)
#:extra-headers http-headers-for-unchanging-content))))))))
(define (render-compare/packages mime-types (define (render-compare/packages mime-types
conn conn
@ -434,14 +452,16 @@
(target (target
. ((commit . ,target-commit) . ((commit . ,target-commit)
(packages . ,(list->vector (packages . ,(list->vector
(package-data-vhash->json target-packages-vhash)))))))) (package-data-vhash->json target-packages-vhash))))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (compare/packages #:sxml (compare/packages
base-commit base-commit
target-commit target-commit
base-packages-vhash base-packages-vhash
target-packages-vhash)))))) target-packages-vhash)
#:extra-headers http-headers-for-unchanging-content)))))
(define (render-derivation conn derivation-file-name) (define (render-derivation conn derivation-file-name)
(let ((derivation (select-derivation-by-file-name conn (let ((derivation (select-derivation-by-file-name conn
@ -460,7 +480,9 @@
#:sxml (view-derivation derivation #:sxml (view-derivation derivation
derivation-inputs derivation-inputs
derivation-outputs derivation-outputs
builds))) builds)
#:extra-headers http-headers-for-unchanging-content))
#f ;; TODO #f ;; TODO
))) )))
@ -478,7 +500,8 @@
((file-name output-id rest ...) ((file-name output-id rest ...)
(select-derivations-using-output (select-derivations-using-output
conn output-id)))) conn output-id))))
derivations))))))) derivations))
#:extra-headers http-headers-for-unchanging-content)))))
(define (parse-commit conn) (define (parse-commit conn)
(lambda (s) (lambda (s)