diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-11-24 12:59:09 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-11-24 20:18:08 +0000 |
| commit | 5663235048b7341b378634d083eaae9f13580e07 (patch) | |
| tree | a714cd2c593517faaca2b01f754646ebc9ae7d41 /guix-data-service/web/controller.scm | |
| parent | 0ffd8caeeb8a0713300ed90bbcad1775078db0af (diff) | |
| download | data-service-5663235048b7341b378634d083eaae9f13580e07.tar data-service-5663235048b7341b378634d083eaae9f13580e07.tar.gz | |
Rework the builds and build_status tables as well as related code
Allow for build status information to be submitted by POST request. This
required some changes to the builds and build_status tables, as for example,
the Cuirass build id may not be available, and the derivation may not be know
yet, so just record the derivation file name.
Diffstat (limited to 'guix-data-service/web/controller.scm')
| -rw-r--r-- | guix-data-service/web/controller.scm | 28 |
1 files changed, 23 insertions, 5 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 1e8d46a..5c21f97 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -21,10 +21,12 @@ #:use-module (ice-9 vlist) #:use-module (ice-9 pretty-print) #:use-module (ice-9 textual-ports) + #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (web request) + #:use-module (web response) #:use-module (web uri) #:use-module (texinfo) #:use-module (texinfo html) @@ -53,6 +55,7 @@ #:use-module (guix-data-service web revision controller) #:use-module (guix-data-service web jobs controller) #:use-module (guix-data-service web view html) + #:use-module (guix-data-service web build-server controller) #:use-module (guix-data-service web compare controller) #:use-module (guix-data-service web revision controller) #:use-module (guix-data-service web repository controller) @@ -102,9 +105,9 @@ (derivation-outputs (select-derivation-outputs-by-derivation-id conn (first derivation))) - (builds (select-builds-with-context-by-derivation-id + (builds (select-builds-with-context-by-derivation-file-name conn - (first derivation)))) + (second derivation)))) (render-html #:sxml (view-derivation derivation derivation-inputs @@ -176,7 +179,9 @@ (static-asset-from-store-renderer) render-static-asset)) -(define (controller request method-and-path-components mime-types body) +(define (controller request method-and-path-components + mime-types body + secret-key-base) (match method-and-path-components (('GET "assets" rest ...) (or (handle-static-assets (string-join rest "/") @@ -223,13 +228,15 @@ method-and-path-components mime-types body - conn)))))) + conn + secret-key-base)))))) (define (controller-with-database-connection request method-and-path-components mime-types body - conn) + conn + secret-key-base) (define path (uri-path (request-uri request))) @@ -241,6 +248,15 @@ conn) (not-found (request-uri request)))) + (define (delegate-to-with-secret-key-base f) + (or (f request + method-and-path-components + mime-types + body + conn + secret-key-base) + (not-found (request-uri request)))) + (match method-and-path-components (('GET) (render-html @@ -276,6 +292,8 @@ (render-formatted-derivation conn (string-append "/gnu/store/" filename)) (not-found (request-uri request)))) + (((or 'GET 'POST) "build-server" _ ...) + (delegate-to-with-secret-key-base build-server-controller)) (('GET "compare" _ ...) (delegate-to compare-controller)) (('GET "compare-by-datetime" _ ...) (delegate-to compare-controller)) (('GET "jobs") (delegate-to jobs-controller)) |