diff options
author | Christopher Baines <mail@cbaines.net> | 2019-04-14 10:04:19 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-04-14 10:04:51 +0100 |
commit | 2e45bb06966a8cab9016afc4b202a056d88c16c3 (patch) | |
tree | 94c1e2537308909a351da029a218705204d9d0cf | |
parent | b352b5040ad028a1415e738212f8b82a5312e0e9 (diff) | |
download | data-service-2e45bb06966a8cab9016afc4b202a056d88c16c3.tar data-service-2e45bb06966a8cab9016afc4b202a056d88c16c3.tar.gz |
Extract out some database functionality to another module
-rw-r--r-- | Makefile.am | 1 | ||||
-rw-r--r-- | guix-data-service/database.scm | 40 | ||||
-rw-r--r-- | guix-data-service/web/server.scm | 18 | ||||
-rw-r--r-- | scripts/guix-data-service-process-branch-updated-email.in | 12 | ||||
-rw-r--r-- | scripts/guix-data-service-process-jobs.in | 7 | ||||
-rw-r--r-- | scripts/guix-data-service-query-build-servers.in | 3 |
6 files changed, 54 insertions, 27 deletions
diff --git a/Makefile.am b/Makefile.am index 8035d90..ad9eddb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -35,6 +35,7 @@ SOURCES = \ guix-data-service/builds.scm \ guix-data-service/comparison.scm \ guix-data-service/config.scm \ + guix-data-service/database.scm \ guix-data-service/jobs.scm \ guix-data-service/jobs/load-new-guix-revision.scm \ guix-data-service/model/build-server.scm \ diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm new file mode 100644 index 0000000..ba7cd64 --- /dev/null +++ b/guix-data-service/database.scm @@ -0,0 +1,40 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (guix-data-service database) + #:use-module (squee) + #:export (with-postgresql-connection)) + +;; TODO This isn't exported for some reason +(define pg-conn-finish + (@@ (squee) pg-conn-finish)) + +(define (with-postgresql-connection f) + (define paramstring + (or (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING") + "dbname=guix_data_service user=guix_data_service")) + + (let* ((conn (connect-to-postgres-paramstring paramstring))) + (with-throw-handler + #t + (lambda () + (let ((result (f conn))) + (pg-conn-finish conn) + result)) + (lambda (key . args) + (pg-conn-finish conn))))) + diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index 81c59fb..ba27c53 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -21,30 +21,14 @@ #:use-module (web http) #:use-module (web request) #:use-module (web uri) - #:use-module (squee) #:use-module (fibers web server) + #:use-module (guix-data-service database) #:use-module (guix-data-service web controller) #:use-module (guix-data-service web util) #:export (start-guix-data-service-web-server)) -;; TODO This isn't exported for some reason -(define pg-conn-finish - (@@ (squee) pg-conn-finish)) - -(define (with-postgresql-connection paramstring f) - (let* ((conn (connect-to-postgres-paramstring paramstring))) - (with-throw-handler - #t - (lambda () - (let ((result (f conn))) - (pg-conn-finish conn) - result)) - (lambda (key . args) - (pg-conn-finish conn))))) - (define (run-controller controller request body) (with-postgresql-connection - "dbname=guix_data_service" (lambda (conn) ((controller request body conn) (cons (request-method request) diff --git a/scripts/guix-data-service-process-branch-updated-email.in b/scripts/guix-data-service-process-branch-updated-email.in index de87dcc..58fb772 100644 --- a/scripts/guix-data-service-process-branch-updated-email.in +++ b/scripts/guix-data-service-process-branch-updated-email.in @@ -25,10 +25,12 @@ (ice-9 textual-ports) (squee) (email email) + (guix-data-service database) (guix-data-service branch-updated-emails)) -(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service"))) - (enqueue-job-for-email - conn - (parse-email - (get-string-all (current-input-port))))) +(with-postgresql-connection + (lambda (conn) + (enqueue-job-for-email + conn + (parse-email + (get-string-all (current-input-port)))))) diff --git a/scripts/guix-data-service-process-jobs.in b/scripts/guix-data-service-process-jobs.in index e2e0935..253ed74 100644 --- a/scripts/guix-data-service-process-jobs.in +++ b/scripts/guix-data-service-process-jobs.in @@ -27,6 +27,7 @@ (squee) (guix-data-service jobs)) -(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service"))) - (simple-format #t "Ready to process jobs...\n") - (process-jobs conn)) +(with-postgresql-connection + (lambda (conn) + (simple-format #t "Ready to process jobs...\n") + (process-jobs conn))) diff --git a/scripts/guix-data-service-query-build-servers.in b/scripts/guix-data-service-query-build-servers.in index e39932b..2451fbf 100644 --- a/scripts/guix-data-service-query-build-servers.in +++ b/scripts/guix-data-service-query-build-servers.in @@ -25,5 +25,4 @@ (squee) (guix-data-service builds)) -(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service"))) - (query-build-servers conn)) +(with-postgresql-connection query-build-servers) |