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

Set a statement timeout of 60 seconds for web requests

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

10
guix-data-service/web/controller.scm
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

30
guix-data-service/web/server.scm
View file

@ -29,30 +29,32 @@
#: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
(let-values (((request-components mime-types) postgresql-statement-timeout)
(request->path-components-and-mime-type request)))
(controller request
(cons (request-method request)
request-components)
mime-types
body
secret-key-base)))
(define (handler request body controller secret-key-base)
(display (display
(format #f "~a ~a\n" (format #f "~a ~a\n"
(request-method request) (request-method request)
(uri-path (request-uri request)))) (uri-path (request-uri request))))
(apply values (apply values
(run-controller controller request body secret-key-base))) (let-values (((request-components mime-types)
(request->path-components-and-mime-type request)))
(controller request
(cons (request-method request)
request-components)
mime-types
body
secret-key-base
#:postgresql-statement-timeout
postgresql-statement-timeout))))
(define (start-guix-data-service-web-server port host secret-key-base) (define* (start-guix-data-service-web-server port host secret-key-base
#:key postgresql-statement-timeout)
(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

22
scripts/guix-data-service.in
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 'host) (assq-ref opts 'port)
(assq-ref opts 'secret-key-base)))) (assq-ref opts 'host)
(assq-ref opts 'secret-key-base)
#:postgresql-statement-timeout
(assq-ref opts 'postgresql-statement-timeout))))