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

Rework inserting derivations

Browse source 
To add more parallelism.
This commit is contained in:
Christopher Baines 2024-10-27 14:02:57 +00:00
parent 1e0407e9b6
commit c650fc6e7a
1 changed files with 206 additions and 177 deletions
Download patch file Download diff file Expand all files Collapse all files

163
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -929,25 +929,25 @@
(define (update-derivation-ids-hash-table! conn (define (update-derivation-ids-hash-table! conn
derivation-ids-hash-table derivation-ids-hash-table
file-names) derivations)
(define file-names-count (vector-length file-names)) (define derivations-count (length derivations))
(simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n" (simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n"
file-names-count) derivations-count)
(let ((missing-file-names (let ((missing-file-names
(vector-fold (fold
(lambda (_ result file-name) (lambda (drv result)
(if (and file-name (if (hash-ref derivation-ids-hash-table
(hash-ref derivation-ids-hash-table (derivation-file-name drv))
file-name))
result result
(cons file-name result))) (cons (derivation-file-name drv)
result)))
'() '()
file-names))) derivations)))
(simple-format (simple-format
#t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n" #t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n"
file-names-count (length missing-file-names)) derivations-count (length missing-file-names))
(unless (null? missing-file-names) (unless (null? missing-file-names)
(for-each (for-each
@ -964,33 +964,17 @@
(define (insert-missing-derivations postgresql-connection-pool (define (insert-missing-derivations postgresql-connection-pool
utility-thread-channel utility-thread-channel
derivation-ids-hash-table derivation-ids-hash-table
derivations) unfiltered-derivations)
(define (ensure-input-derivations-exist input-derivation-file-names) (define (ensure-input-derivations-exist input-derivation-file-names)
(unless (null? input-derivation-file-names) (unless (null? input-derivation-file-names)
;; Ensure all the input derivations exist
(for-each
(lambda (chunk)
(simple-format (simple-format
#t "debug: ensure-input-derivations-exist: processing ~A derivations\n" #t "debug: ensure-input-derivations-exist: processing ~A derivations\n"
(length input-derivation-file-names)) (length chunk))
(with-resource-from-pool postgresql-connection-pool conn
(update-derivation-ids-hash-table! conn
derivation-ids-hash-table
(list->vector
input-derivation-file-names)))
(simple-format
#t
"debug: ensure-input-derivations-exist: checking for missing input derivations\n")
(let ((missing-derivations-filenames
(remove (lambda (derivation-file-name)
(hash-ref derivation-ids-hash-table
derivation-file-name))
input-derivation-file-names)))
(unless (null? missing-derivations-filenames)
(simple-format
#f
"debug: ensure-input-derivations-exist: inserting missing input derivations\n")
;; Ensure all the input derivations exist
(insert-missing-derivations (insert-missing-derivations
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel utility-thread-channel
@ -998,8 +982,8 @@
(call-with-worker-thread (call-with-worker-thread
utility-thread-channel utility-thread-channel
(lambda () (lambda ()
(map read-derivation-from-file (map read-derivation-from-file chunk)))))
missing-derivations-filenames)))))))) (chunk! input-derivation-file-names 1000))))
(define (insert-into-derivations conn drvs) (define (insert-into-derivations conn drvs)
(string-append (string-append
@ -1030,17 +1014,36 @@
(with-time-logging (with-time-logging
(simple-format (simple-format
#f "insert-missing-derivations: inserting ~A derivations" #f "insert-missing-derivations: inserting ~A derivations"
(length derivations)) (length unfiltered-derivations))
(let* ((chunks (chunk derivations 500)) (let ((derivations
(derivation-ids derivation-ids
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(update-derivation-ids-hash-table! conn
derivation-ids-hash-table
unfiltered-derivations)
(let ((derivations
;; Do this while holding the PostgreSQL connection to
;; avoid conflicts with other fibers
(filter-map (lambda (derivation)
(if (hash-ref derivation-ids-hash-table
(derivation-file-name
derivation))
#f
derivation))
unfiltered-derivations)))
(if (null? derivations)
(values '() '())
(let ((derivation-ids
(append-map! (append-map!
(lambda (chunk) (lambda (chunk)
(map (lambda (result) (map (lambda (result)
(string->number (car result))) (string->number (car result)))
(exec-query conn (insert-into-derivations conn chunk)))) (exec-query conn (insert-into-derivations conn chunk))))
chunks)))) (chunk derivations 500))))
;; Do this while holding the connection so that other
;; fibers don't also try inserting the same derivations
(with-time-logging (with-time-logging
"insert-missing-derivations: updating hash table" "insert-missing-derivations: updating hash table"
(for-each (lambda (derivation derivation-id) (for-each (lambda (derivation derivation-id)
@ -1050,9 +1053,14 @@
derivations derivations
derivation-ids)) derivation-ids))
(values derivations
derivation-ids)))))))
(unless (null? derivations)
(parallel-via-fibers
(with-time-logging (with-time-logging
"insert-missing-derivations: inserting sources" "insert-missing-derivations: inserting sources"
(for-each (fibers-for-each
(lambda (derivation-id derivation) (lambda (derivation-id derivation)
(let ((sources (derivation-sources derivation))) (let ((sources (derivation-sources derivation)))
(unless (null? sources) (unless (null? sources)
@ -1063,14 +1071,22 @@
sources)))) sources))))
(par-map& (par-map&
(lambda (id source-file) (lambda (id source-file)
(match (when
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(match
(exec-query (exec-query
conn conn
" "
SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(list (number->string id)))) (list (number->string id)))
(() (()
;; Insert a placeholder to avoid other fibers
;; working on this source file
(insert-placeholder-derivation-source-file-nar
conn
id)
#t)
(_ #f)))
(let ((nar-bytevector (let ((nar-bytevector
(call-with-worker-thread (call-with-worker-thread
utility-thread-channel utility-thread-channel
@ -1084,7 +1100,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(make-missing-store-item-error (make-missing-store-item-error
source-file))) source-file)))
(write-file source-file port) (write-file source-file port)
(get-bytevector))))))) (let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res)))))))
(letpar& (letpar&
((compressed-nar-bytevector ((compressed-nar-bytevector
(call-with-worker-thread (call-with-worker-thread
@ -1098,7 +1116,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(lambda (port) (lambda (port)
(put-bytevector port nar-bytevector)) (put-bytevector port nar-bytevector))
#:level 9) #:level 9)
(get-bytevector)))))) (let ((res (get-bytevector)))
(close-port port) ; maybe reduces memory?
res))))))
(hash (hash
(call-with-worker-thread (call-with-worker-thread
utility-thread-channel utility-thread-channel
@ -1106,15 +1126,13 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(bytevector->nix-base32-string (bytevector->nix-base32-string
(sha256 nar-bytevector))))) (sha256 nar-bytevector)))))
(uncompressed-size (bytevector-length nar-bytevector))) (uncompressed-size (bytevector-length nar-bytevector)))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(insert-derivation-source-file-nar (update-derivation-source-file-nar
conn conn
id id
hash hash
compressed-nar-bytevector compressed-nar-bytevector
uncompressed-size))))) uncompressed-size))))))
(_ #f)))
sources-ids sources-ids
sources))))) sources)))))
derivation-ids derivation-ids
@ -1135,7 +1153,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(ensure-input-derivations-exist (deduplicate-strings (ensure-input-derivations-exist (deduplicate-strings
(map derivation-input-path (map derivation-input-path
(append-map derivation-inputs (append-map derivation-inputs
derivations))))) derivations))))))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(with-time-logging (with-time-logging
@ -1144,7 +1162,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(length derivations)) (length derivations))
(insert-derivation-inputs conn (insert-derivation-inputs conn
derivation-ids derivation-ids
derivations)))))) derivations)))))))
(define (derivation-file-names->derivation-ids postgresql-connection-pool (define (derivation-file-names->derivation-ids postgresql-connection-pool
utility-thread-channel utility-thread-channel
@ -1160,11 +1178,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
#t "debug: derivation-file-names->derivation-ids: processing ~A derivations\n" #t "debug: derivation-file-names->derivation-ids: processing ~A derivations\n"
derivations-count) derivations-count)
(with-resource-from-pool postgresql-connection-pool conn
(update-derivation-ids-hash-table! conn
derivation-ids-hash-table
derivation-file-names))
(let* ((missing-derivation-filenames (let* ((missing-derivation-filenames
(deduplicate-strings (deduplicate-strings
(vector-fold (vector-fold
@ -1192,24 +1205,16 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(chunk! missing-derivation-filenames 1000)))) (chunk! missing-derivation-filenames 1000))))
(for-each (for-each
(lambda (missing-derivation-filenames-chunk) (lambda (missing-derivation-chunk-promise)
(let ((missing-derivations-chunk (let ((missing-derivations-chunk
;; Do the filter again, since processing the last chunk
;; might have inserted some of the derivations in this
;; chunk
(remove! (lambda (derivation)
(hash-ref derivation-ids-hash-table
(derivation-file-name
derivation)))
(fibers-force (fibers-force
missing-derivation-filenames-chunk)))) missing-derivation-chunk-promise)))
(unless (null? missing-derivations-chunk) (unless (null? missing-derivations-chunk)
(insert-missing-derivations postgresql-connection-pool (insert-missing-derivations postgresql-connection-pool
utility-thread-channel utility-thread-channel
derivation-ids-hash-table derivation-ids-hash-table
missing-derivations-chunk)))) missing-derivations-chunk))))
missing-derivations-chunked-promises)) missing-derivations-chunked-promises)
(let ((all-ids (let ((all-ids
(vector-map (vector-map
@ -1217,11 +1222,35 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(if derivation-file-name (if derivation-file-name
(or (hash-ref derivation-ids-hash-table (or (hash-ref derivation-ids-hash-table
derivation-file-name) derivation-file-name)
(error "missing derivation id")) ;; If a derivation ID can't be found, update the
;; hash table then check again
(with-resource-from-pool postgresql-connection-pool conn
(for-each
(lambda (missing-derivations-chunked-promise)
(update-derivation-ids-hash-table!
conn
derivation-ids-hash-table
(fibers-force missing-derivations-chunked-promise)))
missing-derivations-chunked-promises)
(or (hash-ref derivation-ids-hash-table
derivation-file-name)
(error
(simple-format #f "missing derivation id (~A)"
derivation-file-name)))))
#f)) #f))
derivation-file-names))) derivation-file-names)))
all-ids)))) (with-resource-from-pool postgresql-connection-pool conn
(simple-format
(current-error-port)
"guix-data-service: clearing the derivation-ids-hash-table\n")
(hash-clear! derivation-ids-hash-table))
;; Just in case this helps clear memory
(for-each fibers-promise-reset
missing-derivations-chunked-promises)
all-ids)))))
(prevent-inlining-for-tests derivation-file-names->derivation-ids) (prevent-inlining-for-tests derivation-file-names->derivation-ids)