From 918601d9662ae35712672a3a8b5c2d8e60daa46e Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Wed, 30 Oct 2019 09:21:37 +0100
Subject: http: Handle specification deletion and addition.

* src/cuirass/http.scm (url-handler): Handle /admin/specifications/add,
/admin/specifications/delete/*, and /admin/specifications.
---
 src/cuirass/http.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

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)))))
-- 
cgit v1.2.3