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 model utils)
#:use-module (guix-data-service model system)
#:export (valid-systems
valid-targets
#:export (valid-targets
count-derivations
select-derivation-by-file-name
select-derivation-by-file-name-hash
@ -61,16 +60,6 @@
select-derivations-and-build-status
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)
'("arm-linux-gnueabihf"
"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 jobs load-new-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 derivation)
#:use-module (guix-data-service model build-server)
@ -683,7 +684,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(targets
(with-thread-postgresql-connection
valid-targets))
@ -748,7 +749,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(targets
(with-thread-postgresql-connection
valid-targets)))
@ -777,7 +778,7 @@
query-parameters
'datetime
(parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(valid-targets->options
(parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-targets)))
@ -852,7 +853,7 @@
query-parameters
'datetime
(parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(valid-targets->options
(parallel-via-thread-pool-channel
(with-thread-postgresql-connection valid-targets)))
@ -960,7 +961,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(build-server-urls
(with-thread-postgresql-connection
select-build-server-urls-by-id)))
@ -998,7 +999,7 @@
(git-repositories-containing-commit conn target-commit))))
(systems
(with-thread-postgresql-connection
valid-systems)))
list-systems)))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
@ -1033,7 +1034,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(build-server-urls
(with-thread-postgresql-connection
select-build-server-urls-by-id)))
@ -1090,7 +1091,7 @@
(second target-revision-details)))))
(systems
(with-thread-postgresql-connection
valid-systems)))
list-systems)))
(case (most-appropriate-mime-type
'(application/json text/html)
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 model utils)
#: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 package)
#:use-module (guix-data-service model system-test)
@ -219,7 +220,7 @@
'system)
system-test-name))))
(valid-systems
(with-thread-postgresql-connection valid-systems)))
(with-thread-postgresql-connection list-systems)))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
@ -551,7 +552,7 @@
(let ((systems
(parallel-via-thread-pool-channel
(with-thread-postgresql-connection
valid-systems))))
list-systems))))
(lambda (s)
(if (member s systems)
s
@ -627,7 +628,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(targets
(with-thread-postgresql-connection
valid-targets)))
@ -703,7 +704,7 @@
(else
(letpar& ((systems
(with-thread-postgresql-connection
valid-systems))
list-systems))
(targets
(with-thread-postgresql-connection
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-server)
#: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-instance)
#:use-module (guix-data-service model package)
@ -548,7 +549,7 @@
(git-repositories-containing-commit conn
commit-hash))))
(systems
(with-thread-postgresql-connection valid-systems)))
(with-thread-postgresql-connection list-systems)))
(render-html
#:sxml (view-revision-system-tests
commit-hash
@ -1013,7 +1014,7 @@
`((error . "invalid query"))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1104,7 +1105,7 @@
derivations))))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1140,7 +1141,7 @@
`((error . "invalid query"))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1194,7 +1195,7 @@
`((derivations . ,(list->vector derivations)))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1233,7 +1234,7 @@
`((error . "invalid query"))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1330,7 +1331,7 @@
derivation-outputs))))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1357,7 +1358,7 @@
(string-append "/revision/" commit-hash)))
(if (any-invalid-query-parameters? query-parameters)
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
@ -1373,7 +1374,7 @@
(let ((system (assq-ref query-parameters 'system))
(target (assq-ref query-parameters 'target)))
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))
(with-thread-postgresql-connection list-systems))
(targets
(with-thread-postgresql-connection valid-targets))
(build-server-options

5
tests/model-derivation.scm
View File

@ -10,11 +10,6 @@
(lambda (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"
'("0")
(count-derivations conn))))