mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a build servers page
This commit is contained in:
parent
e5e9442b44
commit
6bc753dd0e
|
@ -78,6 +78,12 @@
|
|||
"No build found for this build server and derivation.")
|
||||
#:code 404)))))
|
||||
|
||||
(define (render-build-servers mime-types
|
||||
build-servers)
|
||||
(render-html
|
||||
#:sxml
|
||||
(view-build-servers build-servers)))
|
||||
|
||||
(define (render-build-server mime-types
|
||||
build-server)
|
||||
(render-html
|
||||
|
@ -191,6 +197,10 @@
|
|||
conn
|
||||
secret-key-base)
|
||||
(match method-and-path-components
|
||||
(('GET "build-servers")
|
||||
(let ((build-servers (select-build-servers conn)))
|
||||
(render-build-servers mime-types
|
||||
build-servers)))
|
||||
(('GET "build-server" build-server-id)
|
||||
(let ((build-server (select-build-server conn (string->number
|
||||
build-server-id))))
|
||||
|
|
|
@ -20,6 +20,7 @@
|
|||
#:use-module (guix-data-service web view html)
|
||||
#:use-module (guix-data-service web html-utils)
|
||||
#:export (view-build
|
||||
view-build-servers
|
||||
view-build-server
|
||||
view-signing-key))
|
||||
|
||||
|
@ -89,6 +90,31 @@
|
|||
required-failed-builds))))))
|
||||
'())))))
|
||||
|
||||
(define (view-build-servers build-servers)
|
||||
(layout
|
||||
#:body
|
||||
`(,(header)
|
||||
(div
|
||||
(@ (class "container"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(h2 "Build servers")
|
||||
,@(map
|
||||
(match-lambda
|
||||
((id url lookup-all-derivations?)
|
||||
`(dl
|
||||
(@ (class "dl-horizontal"))
|
||||
(dt "URL")
|
||||
(dd (a (@ (href ,url))
|
||||
,url))
|
||||
(dt "Lookup all " (br) "derivations?")
|
||||
(dd ,(if lookup-all-derivations?
|
||||
"Yes"
|
||||
"No")))))
|
||||
build-servers)))))))
|
||||
|
||||
(define (view-build-server build-server)
|
||||
(layout
|
||||
#:body
|
||||
|
|
|
@ -315,6 +315,8 @@
|
|||
(not-found (request-uri request))))
|
||||
(('GET "gnu" "store" filename "narinfos")
|
||||
(render-narinfos conn filename))
|
||||
(('GET "build-servers")
|
||||
(delegate-to-with-secret-key-base build-server-controller))
|
||||
(((or 'GET 'POST) "build-server" _ ...)
|
||||
(delegate-to-with-secret-key-base build-server-controller))
|
||||
(('GET "compare" _ ...) (delegate-to compare-controller))
|
||||
|
|
Loading…
Reference in a new issue