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

Completely rework the way db connections are handled during requests

Browse source 
Previously, a connection was passed through the code handling the
request. When queries were performed, this could block the thread though,
potentially leaving the server unable to serve other requests.

Instead, this now runs queries in a pool of threads. This should remove the
possibility of blocking the threads used by the web server, and in doing so,
some of the queries have been parallelised.

I''m still not sure about the naming and syntax, but I think the functionality
is a sort of step forward.
This commit is contained in:
Christopher Baines 2020-10-03 21:35:31 +01:00
parent e2e55c69de
commit c3c9c07f9a
9 changed files with 1771 additions and 1366 deletions
Download patch file Download diff file Expand all files Collapse all files

61
guix-data-service/web/build/controller.scm
View file

@ -18,6 +18,8 @@
(define-module (guix-data-service web build controller)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (guix-data-service utils)
#:use-module (guix-data-service database)
#:use-module (guix-data-service web render)
#:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service model build)
@ -34,9 +36,11 @@
(string-append "unknown build status: "
status))))
(define (parse-build-server conn)
(define parse-build-server
(lambda (v)
(let ((build-servers (select-build-servers conn)))
(letpar& ((build-servers
(with-thread-postgresql-connection
select-build-servers)))
(or (any (match-lambda
((id url lookup-all-derivations? lookup-builds?)
(if (eq? (string->number v)
@ -51,21 +55,19 @@
(define (build-controller request
method-and-path-components
mime-types
body
conn)
body)
(match method-and-path-components
(('GET "builds")
(render-builds request
mime-types
conn))
mime-types))
(_ #f)))
(define (render-builds request mime-types conn)
(define (render-builds request mime-types)
(let ((parsed-query-parameters
(parse-query-parameters
request
`((build_status ,parse-build-status #:multi-value)
(build_server ,(parse-build-server conn) #:multi-value)))))
(build_server ,parse-build-server #:multi-value)))))
(if (any-invalid-query-parameters? parsed-query-parameters)
(render-html
#:sxml (view-builds parsed-query-parameters
@ -73,20 +75,29 @@
'()
'()
'()))
(render-html
#:sxml (view-builds parsed-query-parameters
build-status-strings
(map (match-lambda
((id url lookup-all-derivations lookup-builds)
(cons url id)))
(select-build-servers conn))
(select-build-stats
conn
(assq-ref parsed-query-parameters
'build_server))
(select-builds-with-context
conn
(assq-ref parsed-query-parameters
'build_status)
(assq-ref parsed-query-parameters
'build_server)))))))
(letpar& ((build-servers
(with-thread-postgresql-connection
select-build-servers))
(build-stats
(with-thread-postgresql-connection
(lambda (conn)
(select-build-stats
conn
(assq-ref parsed-query-parameters
'build_server)))))
(builds-with-context
(with-thread-postgresql-connection
(lambda (conn)
(select-builds-with-context
conn
(assq-ref parsed-query-parameters
'build_status)
(assq-ref parsed-query-parameters
'build_server))))))
(render-html
#:sxml (view-builds parsed-query-parameters
build-status-strings
build-servers
build-stats
builds-with-context))))))