diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-04-24 10:43:27 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-04-24 10:44:24 +0100 |
| commit | aaecb6b3ff2fb859f59760b7b74cac906954172a (patch) | |
| tree | 70e144f69bf55fa8b89b180721167d370f5a4a06 | |
| parent | 0fb7ce6a7de8454d2eddb390ff6188836cd105e2 (diff) | |
| download | bffe-aaecb6b3ff2fb859f59760b7b74cac906954172a.tar bffe-aaecb6b3ff2fb859f59760b7b74cac906954172a.tar.gz | |
Make the event source configurable
| -rw-r--r-- | bffe/server.scm | 14 | ||||
| -rw-r--r-- | scripts/bffe.in | 7 |
2 files changed, 16 insertions, 5 deletions
diff --git a/bffe/server.scm b/bffe/server.scm index 5eb8d0d..c5f86ed 100644 --- a/bffe/server.scm +++ b/bffe/server.scm @@ -63,7 +63,7 @@ (lambda (scheduler port) (display "#<scheduler>" port))) -(define (make-state-channel) +(define (make-state-channel event-source) (let ((channel (make-channel))) (call-with-new-thread (lambda () @@ -80,7 +80,8 @@ (let ((response body (http-get - (string->uri "http://localhost:8746/state")))) + (string->uri + (string-append event-source "/state"))))) (let ((state (json-string->scm (utf8->string body)))) @@ -104,7 +105,7 @@ (get-message reply-channel))) -(define (make-events-channel initial-state-id) +(define (make-events-channel event-source initial-state-id) (let* ((submission-channel (make-channel)) (listener-channels-box (make-atomic-box vlist-null)) @@ -205,7 +206,8 @@ (let* ((response remote-port (http-get - (string->uri "http://localhost:8746/events") + (string->uri + (string-append event-source "/events")) #:headers `((last-event-id . ,(number->string @@ -450,10 +452,12 @@ #:code 500)))) (define* (start-bffe-web-server port host assets-directory + event-source metrics-registry #:key (controller-args '())) (define state-channel - (make-state-channel)) + (make-state-channel + event-source)) (call-with-error-handling (lambda () diff --git a/scripts/bffe.in b/scripts/bffe.in index d0ca978..b85b2fe 100644 --- a/scripts/bffe.in +++ b/scripts/bffe.in @@ -58,6 +58,11 @@ (alist-cons 'title arg result))) + (option '("event-source") #t #f + (lambda (opt name arg result) + (alist-cons 'event-source + arg + result))) (option '("template-directory") #t #f (lambda (opt name arg result) (alist-cons 'template-directory @@ -77,6 +82,7 @@ install-dir dev-dir))) (title . "Build farm") + (event-source . "http://localhost:8746") (template-directory . ,(let ((install-dir "@prefix@/share/bffe/templates") (dev-dir @@ -118,6 +124,7 @@ (assq-ref opts 'port) (assq-ref opts 'host) (assq-ref opts 'assets-directory) + (assq-ref opts 'event-source) metrics-registry #:controller-args (list (assq-ref opts 'title) |