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