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

Split out inserting into derivation_output_details

Browse source 
So that this can be done when inserting builds.
This commit is contained in:
Christopher Baines 2022-07-08 11:59:26 +01:00
parent 8e23d38660
commit 811256a920
1 changed files with 37 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -53,6 +53,7 @@
select-fixed-output-package-derivations-in-revision
select-derivation-outputs-in-revision
fix-derivation-output-details-hash-encoding
derivation-output-details->derivation-output-details-ids
select-derivations-by-revision-name-and-version
select-derivation-inputs-by-derivation-id
select-serialized-derivation-by-file-name
@ -965,33 +966,28 @@ LOCK TABLE ONLY derivation_output_details
;; Recurse in case there are more to fix
(loop (find-old-derivations-and-hashes conn))))))))
(define (derivation-output-details->derivation-output-details-ids
conn
derivation-output-details)
(insert-missing-data-and-return-all-ids
conn
"derivation_output_details"
'(path hash_algorithm hash recursive)
(map (lambda (details)
(list (assq-ref details 'path)
(or (non-empty-string-or-false
(assq-ref details 'hash_algorithm))
NULL)
(or (non-empty-string-or-false
(assq-ref details 'hash))
NULL)
(assq-ref details 'recursive)))
derivation-output-details)))
(define (insert-derivation-outputs conn
derivation-id
names-and-derivation-outputs)
(define (insert-into-derivation-output-details derivation-outputs)
(string-append
"INSERT INTO derivation_output_details "
"(path, hash_algorithm, hash, recursive) VALUES "
(string-join
(map
(match-lambda
(($ <derivation-output> path hash-algo hash recursive?)
(string-append
"("
(string-join
(list (quote-string path)
(value->quoted-string-or-null
(and=> hash-algo symbol->string))
(value->quoted-string-or-null
(and=> hash bytevector->base16-string))
(if recursive? "TRUE" "FALSE"))
",")
")")))
derivation-outputs)
",")
" RETURNING id"
";"))
(define (insert-into-derivation-outputs output-names
derivation-output-details-ids)
(string-append "INSERT INTO derivation_outputs "
@ -1053,51 +1049,27 @@ VALUES ($1, $2)"
(let* ((derivation-outputs (map cdr names-and-derivation-outputs))
(derivation-output-paths (map derivation-output-path
derivation-outputs))
(existing-derivation-output-details-entries
(exec-query->vhash
conn
(select-from-derivation-output-details
derivation-output-paths)
second ;; path
first)) ;; id
(missing-entries (filter
(lambda (derivation-output)
(not (vhash-assoc
(derivation-output-path derivation-output)
existing-derivation-output-details-entries)))
derivation-outputs))
(new-derivation-output-details-ids
(if (null? missing-entries)
'()
(map car
(exec-query
conn
(insert-into-derivation-output-details missing-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash (map derivation-output-path missing-entries)
new-derivation-output-details-ids))
(derivation-output-names
(map car names-and-derivation-outputs))
(derivation-output-details-ids
(map (lambda (path)
(string->number
(cdr
(or (vhash-assoc path
existing-derivation-output-details-entries)
(vhash-assoc path
new-entries-id-lookup-vhash)
(error "missing derivation output details entry")))))
derivation-output-paths))
(derivation-output-names
(map car names-and-derivation-outputs)))
(derivation-output-details->derivation-output-details-ids
conn
(map
(match-lambda
(($ <derivation-output> path hash-algo hash recursive?)
`((path . ,path)
(hash_algorithm . ,(or (and=> hash-algo symbol->string)
NULL))
(hash . ,(or (and=> hash bytevector->base16-string)
NULL))
(recursive . ,recursive?))))
derivation-outputs))))
(exec-query conn
(insert-into-derivation-outputs derivation-output-names
derivation-output-details-ids))
(insert-into-derivation-outputs
derivation-output-names
derivation-output-details-ids))
(insert-into-derivations-by-output-details-set
(or