diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-12-29 09:09:36 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-12-29 16:04:45 +0000 |
| commit | 7ca9b11885f443a1042768ad48a5bbbebcc38b64 (patch) | |
| tree | 90f72c70aae9837b89b0af93b4cc5e75b6c87e13 | |
| parent | da3a29449645376f64b48c3d87c8f13def1db94c (diff) | |
| download | data-service-7ca9b11885f443a1042768ad48a5bbbebcc38b64.tar data-service-7ca9b11885f443a1042768ad48a5bbbebcc38b64.tar.gz | |
Move rendering narinfo responses out of the main controller function
In preparation for also handling derivation source files.
| -rw-r--r-- | guix-data-service/web/nar/controller.scm | 96 |
1 files changed, 51 insertions, 45 deletions
diff --git a/guix-data-service/web/nar/controller.scm b/guix-data-service/web/nar/controller.scm index 781a01b..9c46eb5 100644 --- a/guix-data-service/web/nar/controller.scm +++ b/guix-data-service/web/nar/controller.scm @@ -81,51 +81,10 @@ conn (string-append "/gnu/store/" file-name))) (('GET (? .narinfo-suffix path)) - (let* ((hash (string-drop-right - path - (string-length ".narinfo"))) - (derivation (select-derivation-by-file-name-hash - conn - hash))) - (if derivation - (list (build-response - #:code 200 - #:headers '((content-type . (application/x-narinfo)))) - (let* ((derivation-file-name - (second derivation)) - (derivation-text - (select-serialized-derivation-by-file-name - conn - derivation-file-name)) - (derivation-bytevector - (string->bytevector derivation-text - "ISO-8859-1")) - (derivation-references - (select-derivation-references-by-derivation-id - conn - (first derivation))) - (nar-bytevector - (call-with-values - (lambda () - (open-bytevector-output-port)) - (lambda (port get-bytevector) - (write-file-tree - derivation-file-name - port - #:file-type+size - (lambda (file) - (values 'regular - (bytevector-length derivation-bytevector))) - #:file-port - (lambda (file) - (open-bytevector-input-port derivation-bytevector))) - (get-bytevector))))) - (lambda (port) - (display (narinfo-string derivation-file-name - nar-bytevector - derivation-references) - port)))) - (not-found (request-uri request))))) + (render-narinfo request + conn + (string-drop-right path + (string-length ".narinfo")))) (_ #f))) (define (render-nar request @@ -171,6 +130,53 @@ (put-bytevector port data))))) (not-found (request-uri request)))) +(define (render-narinfo request + conn + hash) + (or + (and=> (select-derivation-by-file-name-hash conn + hash) + (lambda (derivation) + (list (build-response + #:code 200 + #:headers '((content-type . (application/x-narinfo)))) + (let* ((derivation-file-name + (second derivation)) + (derivation-text + (select-serialized-derivation-by-file-name + conn + derivation-file-name)) + (derivation-bytevector + (string->bytevector derivation-text + "ISO-8859-1")) + (derivation-references + (select-derivation-references-by-derivation-id + conn + (first derivation))) + (nar-bytevector + (call-with-values + (lambda () + (open-bytevector-output-port)) + (lambda (port get-bytevector) + (write-file-tree + derivation-file-name + port + #:file-type+size + (lambda (file) + (values 'regular + (bytevector-length derivation-bytevector))) + #:file-port + (lambda (file) + (open-bytevector-input-port derivation-bytevector))) + (get-bytevector))))) + (lambda (port) + (display (narinfo-string derivation-file-name + nar-bytevector + derivation-references) + port)))))) + (not-found (request-uri request)))) + + (define* (narinfo-string store-item nar-bytevector references |