cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revert "Optimise inserting derivation inputs"

Browse source 
I'm concerned that this approach is more error prone and won't error if there
are issues with the data in the database.

This reverts commit 3081887b90.
This commit is contained in:
Christopher Baines 2025-03-09 13:11:02 +00:00
parent 5684add77e
commit edeb89e0cf
1 changed files with 52 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

92
guix-data-service/model/derivation.scm
View file

@ -1105,6 +1105,25 @@ ON CONFLICT DO NOTHING"
(vector->list (json-string->scm env_vars)))
system))))
(define select-derivation-output-id
(mlambda (conn name path)
(match (exec-query
conn
"
SELECT derivation_outputs.id FROM derivation_outputs
INNER JOIN derivations
ON derivation_outputs.derivation_id = derivations.id
WHERE derivations.file_name = $1
AND derivation_outputs.name = $2"
(list path
name))
(((id))
id)
(()
(error (simple-format
#f "cannot find derivation-output with name ~A and path ~A"
name path))))))
(define (select-derivation-outputs-by-derivation-id conn id)
(define query
(string-append
@ -1377,49 +1396,42 @@ WHERE derivation_source_files.store_path = $1"
#f)))
(define (insert-derivation-inputs conn derivation-ids derivations)
(let ((query-parts
(append-map!
(lambda (derivation-id derivation)
(append-map!
(match-lambda
(($ <derivation-input> derivation-or-path sub-derivations)
(let ((path
(match derivation-or-path
((? derivation? d)
;; The first field changed to a derivation (from the file
;; name) in 5cf4b26d52bcea382d98fb4becce89be9ee37b55
(derivation-file-name d))
((? string? s)
s))))
(map (lambda (sub-derivation)
(string-append "("
(number->string derivation-id)
", '" path
"', '" sub-derivation "')"))
sub-derivations))))
(derivation-inputs derivation)))
(vector->list derivation-ids)
(vector->list derivations))))
(chunk-for-each!
(lambda (query-parts-chunk)
(define (insert-into-derivation-inputs derivation-id output-ids)
(for-each
(lambda (output-id)
(exec-query
conn
(string-append
"
"
INSERT INTO derivation_inputs (derivation_id, derivation_output_id)
SELECT vals.derivation_id, derivation_outputs.id
FROM (VALUES "
(string-join query-parts-chunk ", ")
") AS vals (derivation_id, file_name, output_name)
INNER JOIN derivations
ON derivations.file_name = vals.file_name
INNER JOIN derivation_outputs
ON derivation_outputs.derivation_id = derivations.id
AND vals.output_name = derivation_outputs.name
ON CONFLICT DO NOTHING")))
1000
query-parts)))
VALUES ($1, $2);"
(list (number->string derivation-id) output-id)))
output-ids))
(vector-for-each
(lambda (i derivation-id derivation)
(let ((inputs (derivation-inputs derivation)))
(unless (null? inputs)
(insert-into-derivation-inputs
derivation-id
(append-map!
(match-lambda
(($ <derivation-input> derivation-or-path sub-derivations)
(let ((path
(match derivation-or-path
((? derivation? d)
;; The first field changed to a derivation (from the file
;; name) in 5cf4b26d52bcea382d98fb4becce89be9ee37b55
(derivation-file-name d))
((? string? s)
s))))
(map (lambda (sub-derivation)
(select-derivation-output-id conn
sub-derivation
path))
sub-derivations))))
inputs)))))
derivation-ids
derivations))
(define (insert-derivation-sources conn derivation-id sources)
(define (insert-into-derivation-sources derivation-source-file-ids)