cbaines pushed a commit to branch trunk
in repository data-service.
commit bf3fdfd8d300a1f32e11f30e386441d5a5e98c60
Author: Christopher Baines <[email protected]>
AuthorDate: Mon Mar 10 10:23:39 2025 +0000
Add fix-derivation
To the load data module, since this is where most of the useful code is.
---
guix-data-service/jobs/load-new-guix-revision.scm | 71 ++++++++++++++++++++++-
1 file changed, 70 insertions(+), 1 deletion(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index c8bf2e6..c61eed7 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -95,7 +95,9 @@
guix-revision-loaded-successfully?
record-job-event
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
(@@ (guix inferior) inferior-package-id))
@@ -1229,6 +1231,73 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
derivation-ids
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
call-with-utility-thread
read-derivations/fiberized
