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

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

@ -81,51 +81,10 @@
conn conn
(string-append "/gnu/store/" file-name))) (string-append "/gnu/store/" file-name)))
(('GET (? .narinfo-suffix path)) (('GET (? .narinfo-suffix path))
(let* ((hash (string-drop-right (render-narinfo request
path
(string-length ".narinfo")))
(derivation (select-derivation-by-file-name-hash
conn conn
hash))) (string-drop-right path
(if derivation (string-length ".narinfo"))))
(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)))))
(_ #f))) (_ #f)))
(define (render-nar request (define (render-nar request
@ -171,6 +130,53 @@
(put-bytevector port data))))) (put-bytevector port data)))))
(not-found (request-uri request)))) (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 (define* (narinfo-string store-item
nar-bytevector nar-bytevector
references references