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

Move rendering narinfo responses out of the main controller function

Browse source 
In preparation for also handling derivation source files.
This commit is contained in:
Christopher Baines 2019-12-29 09:09:36 +00:00
parent da3a294496
commit 7ca9b11885
1 changed files with 51 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

96
guix-data-service/web/nar/controller.scm
View file

@ -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