mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Adjust render procedures to not use procedures for responses
The newer Guile Fibers web server will use the chunked transfer encoding when a procedure is used and the content length is unspecified. This is good for large responses, but unnecessary here. Also, there's a bug with the charset so these changes to respond with correctly encoded bytevectors to avoid that.
This commit is contained in:
parent
0ce5af2c59
commit
6be113f99d
1 changed files with 19 additions and 9 deletions
|
@ -24,6 +24,7 @@
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
|
#:use-module (ice-9 iconv)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
#:use-module (web request)
|
#:use-module (web request)
|
||||||
#:use-module (web response)
|
#:use-module (web response)
|
||||||
|
@ -142,30 +143,39 @@
|
||||||
(list (build-response
|
(list (build-response
|
||||||
#:code code
|
#:code code
|
||||||
#:headers (append extra-headers
|
#:headers (append extra-headers
|
||||||
'((content-type . (text/html))
|
'((content-type . (text/html
|
||||||
|
(charset . "utf-8")))
|
||||||
(vary . (accept)))))
|
(vary . (accept)))))
|
||||||
(lambda (port)
|
(call-with-encoded-output-string
|
||||||
(sxml->html sxml port))))
|
"utf-8"
|
||||||
|
(lambda (port)
|
||||||
|
(sxml->html sxml port)))))
|
||||||
|
|
||||||
(define* (render-json json #:key (extra-headers '())
|
(define* (render-json json #:key (extra-headers '())
|
||||||
(code 200))
|
(code 200))
|
||||||
(list (build-response
|
(list (build-response
|
||||||
#:code code
|
#:code code
|
||||||
#:headers (append extra-headers
|
#:headers (append extra-headers
|
||||||
'((content-type . (application/json))
|
'((content-type . (application/json
|
||||||
|
(charset . "utf-8")))
|
||||||
(vary . (accept)))))
|
(vary . (accept)))))
|
||||||
(lambda (port)
|
(call-with-encoded-output-string
|
||||||
(scm->json json port))))
|
"utf-8"
|
||||||
|
(lambda (port)
|
||||||
|
(scm->json json port)))))
|
||||||
|
|
||||||
(define* (render-text text #:key (extra-headers '())
|
(define* (render-text text #:key (extra-headers '())
|
||||||
(code 200))
|
(code 200))
|
||||||
(list (build-response
|
(list (build-response
|
||||||
#:code code
|
#:code code
|
||||||
#:headers (append extra-headers
|
#:headers (append extra-headers
|
||||||
'((content-type . (text/plain))
|
'((content-type . (text/plain
|
||||||
|
(charset . "utf-8")))
|
||||||
(vary . (accept)))))
|
(vary . (accept)))))
|
||||||
(lambda (port)
|
(call-with-encoded-output-string
|
||||||
(display text port))))
|
"utf-8"
|
||||||
|
(lambda (port)
|
||||||
|
(display text port)))))
|
||||||
|
|
||||||
(define (not-found uri)
|
(define (not-found uri)
|
||||||
(list (build-response #:code 404)
|
(list (build-response #:code 404)
|
||||||
|
|
Loading…
Reference in a new issue