diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2019-10-30 09:21:37 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2019-10-30 09:21:37 +0100 |
| commit | 918601d9662ae35712672a3a8b5c2d8e60daa46e (patch) | |
| tree | fa44e6aa9afbd5d8865b6d00c64f9286d6456cc5 | |
| parent | 53fe4996be9ceaa11cae6295af3195e66f9711a5 (diff) | |
| download | cuirass-918601d9662ae35712672a3a8b5c2d8e60daa46e.tar cuirass-918601d9662ae35712672a3a8b5c2d8e60daa46e.tar.gz | |
http: Handle specification deletion and addition.
* src/cuirass/http.scm (url-handler): Handle /admin/specifications/add,
/admin/specifications/delete/*, and /admin/specifications.
| -rw-r--r-- | src/cuirass/http.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 5593506..d1362b5 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -40,6 +40,7 @@ #:use-module (web uri) #:use-module (fibers) #:use-module (fibers channels) + #:use-module ((rnrs bytevectors) #:select (utf8->string)) #:use-module (sxml simple) #:use-module (cuirass templates) #:use-module (guix utils) @@ -248,6 +249,41 @@ Hydra format." (match (cons (request-method request) (request-path-components request)) + (('POST "admin" "specifications" "add") + (match (string-split (utf8->string body) #\=) + (("spec-name" name) + (db-add-specification + `((#:name . ,name) + (#:load-path-inputs . ()) + (#:package-path-inputs . ()) + (#:proc . cuirass-jobs) + (#:proc-input . ,name) + (#:proc-file . "build-aux/cuirass/gnu-system.scm") + (#:proc-args . (systems "x86_64-linux" + "i686-linux" + "armhf-linux" + "aarch64-linux")) + (#:inputs . + '((#:name . ,name) + (#:url . "https://git.savannah.gnu.org/git/guix.git") + (#:load-path . ".") + (#:branch . ,name) + (#:no-compile? . #t))))) + (respond (build-response #:code 302 + #:headers `((location . ,(string->uri-reference + "/admin/specifications")))) + #:body "")))) + (('POST "admin" "specifications" "delete" name) + (db-remove-specification name) + (respond (build-response #:code 302 + #:headers `((location . ,(string->uri-reference + "/admin/specifications")))) + #:body "")) + (('GET "admin" "specifications" . rest) + (respond-html (html-page + "Cuirass [Admin]" + (specifications-table (db-get-specifications) 'admin) + '()))) (('GET (or "jobsets" "specifications") . rest) (respond-json (object->json-string (list->vector (db-get-specifications))))) |