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 (if system
(string-append (string-append
" AND package_derivations.system_id = " " AND package_derivations.system_id = "
(number->string (system->system-id conn system))) (number->string (lookup-system-id conn system)))
"") "")
(if targets (if targets
(string-append (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 (get-sql-to-select-package-and-related-derivations-for-revision
conn conn
(commit->revision-id conn revision-commit) (commit->revision-id conn revision-commit)
#:system-id (system->system-id conn system) #:system-id (lookup-system-id conn system)
#:target target) #:target target)
(string-append (string-append
" "
@ -369,7 +369,7 @@ WITH RECURSIVE all_derivations AS (
(simple-format (simple-format
#f " #f "
AND system_id = ~A\n" AND system_id = ~A\n"
(system->system-id conn system)) (lookup-system-id conn system))
"") "")
(if target (if target
(simple-format (simple-format

View file

@ -22,6 +22,7 @@
#:use-module (squee) #:use-module (squee)
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
#:export (system->system-id #:export (system->system-id
lookup-system-id
list-systems)) list-systems))
(define system->system-id-cache (define system->system-id-cache
@ -45,6 +46,22 @@
(set! systems-cache #f) (set! systems-cache #f)
id))))) 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) (define (list-systems conn)
(if systems-cache (if systems-cache
systems-cache systems-cache