Set a statement timeout of 60 seconds for web requests

This will help stop queries running for an unnecessarily long time, longer
than NGinx will wait for example.
This commit is contained in:
Christopher Baines 2020-04-24 09:00:20 +01:00
parent 0cc78b90ae
commit a0263a0eae
3 changed files with 38 additions and 24 deletions

View file

@ -185,9 +185,10 @@
(define %show-error-details (define %show-error-details
(make-parameter #f)) (make-parameter #f))
(define (controller request method-and-path-components (define* (controller request method-and-path-components
mime-types body mime-types body
secret-key-base) secret-key-base
#:key postgresql-statement-timeout)
(define (controller-thunk) (define (controller-thunk)
(match method-and-path-components (match method-and-path-components
(('GET "assets" rest ...) (('GET "assets" rest ...)
@ -236,7 +237,8 @@
mime-types mime-types
body body
conn conn
secret-key-base)))))) secret-key-base))
#:statement-timeout postgresql-statement-timeout))))
(call-with-error-handling (call-with-error-handling
controller-thunk controller-thunk
#:on-error 'backtrace #:on-error 'backtrace

View file

@ -29,7 +29,13 @@
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:export (start-guix-data-service-web-server)) #:export (start-guix-data-service-web-server))
(define (run-controller controller request body secret-key-base) (define (handler request body controller secret-key-base
postgresql-statement-timeout)
(display
(format #f "~a ~a\n"
(request-method request)
(uri-path (request-uri request))))
(apply values
(let-values (((request-components mime-types) (let-values (((request-components mime-types)
(request->path-components-and-mime-type request))) (request->path-components-and-mime-type request)))
(controller request (controller request
@ -37,22 +43,18 @@
request-components) request-components)
mime-types mime-types
body body
secret-key-base))) secret-key-base
#:postgresql-statement-timeout
postgresql-statement-timeout))))
(define (handler request body controller secret-key-base) (define* (start-guix-data-service-web-server port host secret-key-base
(display #:key postgresql-statement-timeout)
(format #f "~a ~a\n"
(request-method request)
(uri-path (request-uri request))))
(apply values
(run-controller controller request body secret-key-base)))
(define (start-guix-data-service-web-server port host secret-key-base)
(call-with-error-handling (call-with-error-handling
(lambda () (lambda ()
(run-server (lambda (request body) (run-server (lambda (request body)
(handler request body controller (handler request body controller
secret-key-base)) secret-key-base
postgresql-statement-timeout))
#:host host #:host host
#:port port)) #:port port))
#:on-error 'backtrace #:on-error 'backtrace

View file

@ -82,8 +82,13 @@
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'host (alist-cons 'host
arg arg
(alist-delete 'host result)))))) (alist-delete 'host result))))
(option '("postgresql-statement-timeout") #t #f
(lambda (opt name arg result)
(alist-cons 'postgresql-statement-timeout
(string->number arg)
(alist-delete 'postgresql-statement-timeout
result))))))
(define %default-options (define %default-options
;; Alist of default option values ;; Alist of default option values
@ -97,7 +102,9 @@
("" #f) ("" #f)
(_ #t))) (_ #t)))
(port . 8765) (port . 8765)
(host . "0.0.0.0"))) (host . "0.0.0.0")
(postgresql-statement-timeout . 60000)))
(define (parse-options args) (define (parse-options args)
(args-fold (args-fold
@ -187,6 +194,9 @@
(assq-ref opts 'host) (assq-ref opts 'host)
(assq-ref opts 'port)) (assq-ref opts 'port))
(start-guix-data-service-web-server (assq-ref opts 'port) (start-guix-data-service-web-server
(assq-ref opts 'port)
(assq-ref opts 'host) (assq-ref opts 'host)
(assq-ref opts 'secret-key-base)))) (assq-ref opts 'secret-key-base)
#:postgresql-statement-timeout
(assq-ref opts 'postgresql-statement-timeout))))