Stop queries being able to insert systems

This commit is contained in:
Christopher Baines 2024-11-13 09:55:03 +00:00
parent e7ada1bada
commit 84e78ef3ed
3 changed files with 20 additions and 3 deletions

View file

@ -271,7 +271,7 @@ GROUP BY derivation_source_files.store_path"))
(if system
(string-append
" AND package_derivations.system_id = "
(number->string (system->system-id conn system)))
(number->string (lookup-system-id conn system)))
"")
(if targets
(string-append

View file

@ -353,7 +353,7 @@ WHERE status IN ('failed', 'failed-dependency', 'failed-other', 'canceled')
(get-sql-to-select-package-and-related-derivations-for-revision
conn
(commit->revision-id conn revision-commit)
#:system-id (system->system-id conn system)
#:system-id (lookup-system-id conn system)
#:target target)
(string-append
"
@ -369,7 +369,7 @@ WITH RECURSIVE all_derivations AS (
(simple-format
#f "
AND system_id = ~A\n"
(system->system-id conn system))
(lookup-system-id conn system))
"")
(if target
(simple-format

View file

@ -22,6 +22,7 @@
#:use-module (squee)
#:use-module (guix-data-service model utils)
#:export (system->system-id
lookup-system-id
list-systems))
(define system->system-id-cache
@ -45,6 +46,22 @@
(set! systems-cache #f)
id)))))
(define (lookup-system-id conn system)
(let ((cached-value (hash-ref system->system-id-cache
system)))
(or cached-value
(match (exec-query
conn
"SELECT id FROM systems WHERE system = $1"
(list system))
(((id-string))
(let ((id (string->number id-string)))
(hash-set! system->system-id-cache
system
id)
id))
(() #f)))))
(define (list-systems conn)
(if systems-cache
systems-cache