mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
http: Add DB argument to 'url-handler'.
* src/cuirass/http.scm (not-found): Delete. (url-handler): Add DB argument. (run-cuirass-server): Likewise. Pass it to 'run-server' STATE argument.
This commit is contained in:
parent
3b72a158be
commit
5973db52c6
1 changed files with 14 additions and 12 deletions
|
@ -58,18 +58,20 @@
|
|||
(define (request-path-components request)
|
||||
(split-and-decode-uri-path (uri-path (request-uri request))))
|
||||
|
||||
(define (not-found request)
|
||||
(values (build-response #:code 404)
|
||||
(string-append "Resource not found: "
|
||||
(uri->string (request-uri request)))))
|
||||
|
||||
(define (url-handler request body)
|
||||
(define (url-handler request body db)
|
||||
(define* (respond response #:key body (db db))
|
||||
(values response body db))
|
||||
(match (request-path-components request)
|
||||
(((or "jobsets" "specifications") . rest)
|
||||
(values '((content-type . (application/json)))
|
||||
(with-database db
|
||||
(spec->json-string (car (db-get-specifications db))))))
|
||||
(_ (not-found request))))
|
||||
(respond '((content-type . (application/json)))
|
||||
#:body (spec->json-string (car (db-get-specifications db)))))
|
||||
(_
|
||||
(respond (build-response #:code 404)
|
||||
#:body (string-append "Resource not found: "
|
||||
(uri->string (request-uri request)))))))
|
||||
|
||||
(define (run-cuirass-server)
|
||||
(run-server url-handler))
|
||||
(define (run-cuirass-server db)
|
||||
(run-server url-handler
|
||||
'http ;server implementation
|
||||
'() ;implementation parameters
|
||||
db)) ;state
|
||||
|
|
Loading…
Reference in a new issue