diff options
| -rw-r--r-- | bffe/server.scm | 92 |
1 files changed, 92 insertions, 0 deletions
diff --git a/bffe/server.scm b/bffe/server.scm index 79aa55a..3cff3be 100644 --- a/bffe/server.scm +++ b/bffe/server.scm @@ -409,6 +409,18 @@ (("") '()) (() '())))) + (define (query-parameters->string query-parameters) + (if (null? query-parameters) + "" + (string-append + "?" + (string-join + (map (match-lambda + ((k . v) + (string-append k "=" v))) + query-parameters) + "&")))) + (define handle-static-assets (if (string-prefix? (%store-prefix) assets-directory) @@ -507,6 +519,59 @@ ((= (response-code response) 200) 200) ((= (response-code response) 404) 404) (else 500))))))) + + (('GET "builds") + (let* ((query-parameters + (request->query-parameters request)) + (response + body + (http-get* + (string->uri + (string-append event-source "/builds" + (query-parameters->string + query-parameters))) + #:headers '((accept . ((application/json))))))) + (case (most-appropriate-mime-type + mime-types + '(application/json text/html)) + ((application/json) + (render-json + (json->scm body) + #:code (response-code response))) + (else + ;; TODO Make this a page + (render-html + (general-not-found + "Page not found" + "") + #:code 404))))) + + (('GET "agents") + (let* ((query-parameters + (request->query-parameters request)) + (response + body + (http-get* + (string->uri + (string-append event-source "/agents" + (query-parameters->string + query-parameters))) + #:headers '((accept . ((application/json))))))) + (case (most-appropriate-mime-type + mime-types + '(application/json text/html)) + ((application/json) + (render-json + (json->scm body) + #:code (response-code response))) + (else + ;; TODO Make this a page + (render-html + (general-not-found + "Page not found" + "") + #:code 404))))) + (('GET "agent" agent-id) (let ((response body @@ -542,6 +607,33 @@ (render-html (build-allocation-plan title agent-id (json->scm body))))))) + + (('GET "setup-failures") + (let* ((query-parameters + (request->query-parameters request)) + (response + body + (http-get* + (string->uri + (string-append event-source "/setup-failures" + (query-parameters->string + query-parameters))) + #:headers '((accept . ((application/json))))))) + (case (most-appropriate-mime-type + mime-types + '(application/json text/html)) + ((application/json) + (render-json + (json->scm body) + #:code (response-code response))) + (else + ;; TODO Make this a page + (render-html + (general-not-found + "Page not found" + "") + #:code 404))))) + (('GET "assets" rest ...) (or (handle-static-assets (string-join rest "/") (request-headers request)) |