Add fix-derivation

To the load data module, since this is where most of the useful code is.
This commit is contained in:
Christopher Baines 2025-03-10 10:23:39 +00:00
parent 35281c8a49
commit bf3fdfd8d3

View file

@ -95,7 +95,9 @@
guix-revision-loaded-successfully? guix-revision-loaded-successfully?
record-job-event record-job-event
enqueue-load-new-guix-revision-job enqueue-load-new-guix-revision-job
most-recent-n-load-new-guix-revision-jobs)) most-recent-n-load-new-guix-revision-jobs
fix-derivation))
(define inferior-package-id (define inferior-package-id
(@@ (guix inferior) inferior-package-id)) (@@ (guix inferior) inferior-package-id))
@ -1229,6 +1231,73 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
derivation-ids derivation-ids
derivations)))))) derivations))))))
(define (fix-derivation file-name)
(define (derivation-missing-inputs? conn drv-id)
(let ((inputs (select-derivation-inputs-by-derivation-id
conn
drv-id)))
;; TODO Detect missing inputs, as well as them all missing
(null? inputs)))
(define (derivation-missing-sources? conn drv-id)
(let ((sources (select-derivation-sources-by-derivation-id
conn
drv-id)))
;; TODO Detect missing inputs, as well as them all missing
(null? sources)))
(run-fibers
(lambda ()
(with-postgresql-connection
"fix"
(lambda (conn)
(let ((drv (read-derivation-from-file file-name))
(postgresql-connection-pool
(make-resource-pool
(const conn)
1
#:name "postgres"))
(call-with-utility-thread
(lambda (thunk)
(thunk)))
(derivation-ids-hash-table
(make-hash-table)))
(match (select-derivation-by-file-name conn (derivation-file-name drv))
((drv-id rest ...)
(when (and (derivation-missing-sources? conn drv-id)
(not (null? (derivation-sources drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(derivations-insert-sources postgresql-connection-pool
call-with-utility-thread
(vector drv)
(vector drv-id)))))
(when (and (derivation-missing-inputs? conn drv-id)
(not (null? (derivation-inputs drv))))
(with-postgresql-transaction
conn
(lambda (conn)
(let ((input-derivations
(map derivation-input-derivation
(derivation-inputs drv))))
(unless (null? input-derivations)
;; Ensure all the input derivations exist
(for-each
(lambda (chunk)
(insert-missing-derivations
postgresql-connection-pool
call-with-utility-thread
derivation-ids-hash-table
chunk))
(chunk! input-derivations 1000))))))
(fix-derivation-inputs conn drv))))))))
#:hz 0
#:parallelism 1))
(define* (derivation-file-names->derivation-ids postgresql-connection-pool (define* (derivation-file-names->derivation-ids postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized