guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Fetch the list of system values from the database 

This removes the need to hardcode some values in the code.
This commit is contained in:
Christopher Baines 2021-04-23 11:20:36 +01:00
parent b430c632b7
commit 6387f1bc67
5 changed files with 25 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix-data-service/model/derivation.scm
View File

@ -34,8 +34,7 @@
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
#:use-module (guix-data-service model system) #:use-module (guix-data-service model system)
#:export (valid-systems #:export (valid-targets
valid-targets
count-derivations count-derivations
select-derivation-by-file-name select-derivation-by-file-name
select-derivation-by-file-name-hash select-derivation-by-file-name-hash
@ -61,16 +60,6 @@
select-derivations-and-build-status select-derivations-and-build-status
derivation-file-names->derivation-ids)) derivation-file-names->derivation-ids))
(define (valid-systems conn)
;; TODO, use the database, but make it quick!
'("aarch64-linux"
"armhf-linux"
"i586-gnu"
"i686-linux"
"mips64el-linux"
"powerpc64le-linux"
"x86_64-linux"))
(define (valid-targets conn) (define (valid-targets conn)
'("arm-linux-gnueabihf" '("arm-linux-gnueabihf"
"aarch64-linux-gnu" "aarch64-linux-gnu"

17
guix-data-service/web/compare/controller.scm
View File

@ -34,6 +34,7 @@
#:use-module (guix-data-service comparison) #:use-module (guix-data-service comparison)
#:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service jobs load-new-guix-revision)
#:use-module (guix-data-service model guix-revision) #:use-module (guix-data-service model guix-revision)
#:use-module (guix-data-service model system)
#:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service model derivation) #:use-module (guix-data-service model derivation)
#:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-server)
@ -683,7 +684,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(targets (targets
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-targets)) valid-targets))
@ -748,7 +749,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(targets (targets
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-targets))) valid-targets)))
@ -777,7 +778,7 @@
query-parameters query-parameters
'datetime 'datetime
(parallel-via-thread-pool-channel (parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(valid-targets->options (valid-targets->options
(parallel-via-thread-pool-channel (parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
@ -852,7 +853,7 @@
query-parameters query-parameters
'datetime 'datetime
(parallel-via-thread-pool-channel (parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(valid-targets->options (valid-targets->options
(parallel-via-thread-pool-channel (parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
@ -960,7 +961,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(build-server-urls (build-server-urls
(with-thread-postgresql-connection (with-thread-postgresql-connection
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
@ -998,7 +999,7 @@
(git-repositories-containing-commit conn target-commit)))) (git-repositories-containing-commit conn target-commit))))
(systems (systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems))) list-systems)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
@ -1033,7 +1034,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(build-server-urls (build-server-urls
(with-thread-postgresql-connection (with-thread-postgresql-connection
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
@ -1090,7 +1091,7 @@
(second target-revision-details))))) (second target-revision-details)))))
(systems (systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems))) list-systems)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)

9
guix-data-service/web/repository/controller.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
#:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-server)
#:use-module (guix-data-service model system)
#:use-module (guix-data-service model derivation) #:use-module (guix-data-service model derivation)
#:use-module (guix-data-service model package) #:use-module (guix-data-service model package)
#:use-module (guix-data-service model system-test) #:use-module (guix-data-service model system-test)
@ -219,7 +220,7 @@
'system) 'system)
system-test-name)))) system-test-name))))
(valid-systems (valid-systems
(with-thread-postgresql-connection valid-systems))) (with-thread-postgresql-connection list-systems)))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
@ -551,7 +552,7 @@
(let ((systems (let ((systems
(parallel-via-thread-pool-channel (parallel-via-thread-pool-channel
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)))) list-systems))))
(lambda (s) (lambda (s)
(if (member s systems) (if (member s systems)
s s
@ -627,7 +628,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(targets (targets
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-targets))) valid-targets)))
@ -703,7 +704,7 @@
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-systems)) list-systems))
(targets (targets
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-targets))) valid-targets)))

19
guix-data-service/web/revision/controller.scm
View File

@ -35,6 +35,7 @@
#:use-module (guix-data-service model build) #:use-module (guix-data-service model build)
#:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-server)
#:use-module (guix-data-service model build-status) #:use-module (guix-data-service model build-status)
#:use-module (guix-data-service model system)
#:use-module (guix-data-service model channel-news) #:use-module (guix-data-service model channel-news)
#:use-module (guix-data-service model channel-instance) #:use-module (guix-data-service model channel-instance)
#:use-module (guix-data-service model package) #:use-module (guix-data-service model package)
@ -548,7 +549,7 @@
(git-repositories-containing-commit conn (git-repositories-containing-commit conn
commit-hash)))) commit-hash))))
(systems (systems
(with-thread-postgresql-connection valid-systems))) (with-thread-postgresql-connection list-systems)))
(render-html (render-html
#:sxml (view-revision-system-tests #:sxml (view-revision-system-tests
commit-hash commit-hash
@ -1013,7 +1014,7 @@
`((error . "invalid query")))) `((error . "invalid query"))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1104,7 +1105,7 @@
derivations)))))) derivations))))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1140,7 +1141,7 @@
`((error . "invalid query")))) `((error . "invalid query"))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1194,7 +1195,7 @@
`((derivations . ,(list->vector derivations))))) `((derivations . ,(list->vector derivations)))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1233,7 +1234,7 @@
`((error . "invalid query")))) `((error . "invalid query"))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1330,7 +1331,7 @@
derivation-outputs)))))) derivation-outputs))))))
(else (else
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1357,7 +1358,7 @@
(string-append "/revision/" commit-hash))) (string-append "/revision/" commit-hash)))
(if (any-invalid-query-parameters? query-parameters) (if (any-invalid-query-parameters? query-parameters)
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets))) (with-thread-postgresql-connection valid-targets)))
(render-html (render-html
@ -1373,7 +1374,7 @@
(let ((system (assq-ref query-parameters 'system)) (let ((system (assq-ref query-parameters 'system))
(target (assq-ref query-parameters 'target))) (target (assq-ref query-parameters 'target)))
(letpar& ((systems (letpar& ((systems
(with-thread-postgresql-connection valid-systems)) (with-thread-postgresql-connection list-systems))
(targets (targets
(with-thread-postgresql-connection valid-targets)) (with-thread-postgresql-connection valid-targets))
(build-server-options (build-server-options

5
tests/model-derivation.scm
View File

@ -10,11 +10,6 @@
(lambda (conn) (lambda (conn)
(check-test-database! conn) (check-test-database! conn)
(test-equal "valid-systems"
'("aarch64-linux" "armhf-linux" "i586-gnu"
"i686-linux" "mips64el-linux" "powerpc64le-linux" "x86_64-linux")
(valid-systems conn))
(test-equal "count-derivations" (test-equal "count-derivations"
'("0") '("0")
(count-derivations conn)))) (count-derivations conn))))