[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: Fetch the list of system values from the database
|
From: |
Christopher Baines |
|
Subject: |
03/03: Fetch the list of system values from the database |
|
Date: |
Fri, 23 Apr 2021 06:21:38 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit 6387f1bc67579485aeb11d5dfa8476ad906bef8c
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Apr 23 11:20:36 2021 +0100
Fetch the list of system values from the database
This removes the need to hardcode some values in the code.
---
guix-data-service/model/derivation.scm | 13 +------------
guix-data-service/web/compare/controller.scm | 17 +++++++++--------
guix-data-service/web/repository/controller.scm | 9 +++++----
guix-data-service/web/revision/controller.scm | 19 ++++++++++---------
tests/model-derivation.scm | 5 -----
5 files changed, 25 insertions(+), 38 deletions(-)
diff --git a/guix-data-service/model/derivation.scm
b/guix-data-service/model/derivation.scm
index 099d4cb..d69778d 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -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"
diff --git a/guix-data-service/web/compare/controller.scm
b/guix-data-service/web/compare/controller.scm
index 895bb40..30cf835 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -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)
diff --git a/guix-data-service/web/repository/controller.scm
b/guix-data-service/web/repository/controller.scm
index e79cc7f..aa31df6 100644
--- a/guix-data-service/web/repository/controller.scm
+++ b/guix-data-service/web/repository/controller.scm
@@ -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)))
diff --git a/guix-data-service/web/revision/controller.scm
b/guix-data-service/web/revision/controller.scm
index 9ab702d..8f767f8 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -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
diff --git a/tests/model-derivation.scm b/tests/model-derivation.scm
index d6e77b3..59f3f75 100644
--- a/tests/model-derivation.scm
+++ b/tests/model-derivation.scm
@@ -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))))