aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/model/derivation.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-07-16 16:06:46 +0100
committerChristopher Baines <mail@cbaines.net>2024-07-16 16:06:46 +0100
commit1754d1a321525f00744e5c04d05dcbf54d7a7fa0 (patch)
tree966552fd23beee34b6c37982876002382b84d548 /guix-data-service/model/derivation.scm
parenta61c4baccd14fcc809ea677d5687e1036f0ee721 (diff)
downloaddata-service-1754d1a321525f00744e5c04d05dcbf54d7a7fa0.tar
data-service-1754d1a321525f00744e5c04d05dcbf54d7a7fa0.tar.gz
Stop inserting missing source file nars
This was more an issue several years ago, so this code is not really needed now.
Diffstat (limited to 'guix-data-service/model/derivation.scm')
-rw-r--r--guix-data-service/model/derivation.scm149
1 files changed, 69 insertions, 80 deletions
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index 02fd175..7023eef 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -1806,46 +1806,42 @@ WHERE " criteria ";"))
(exec-query conn (select-existing-derivations chunk))))
(chunk! missing-file-names 1000)))))
-(define (derivation-file-names->derivation-ids conn derivation-file-names)
- (define derivations-count
- (vector-length derivation-file-names))
-
- (define (insert-source-files-missing-nars derivation-ids)
- (define (derivation-ids->next-related-derivation-ids! ids seen-ids)
- (delete-duplicates/sort!
- (append-map!
- (lambda (ids-chunk)
- (let ((query
- (string-append
- "
+(define (insert-source-files-missing-nars conn derivation-ids)
+ (define (derivation-ids->next-related-derivation-ids! ids seen-ids)
+ (delete-duplicates/sort!
+ (append-map!
+ (lambda (ids-chunk)
+ (let ((query
+ (string-append
+ "
SELECT derivation_outputs.derivation_id
FROM derivation_inputs
INNER JOIN derivation_outputs
ON derivation_outputs.id = derivation_inputs.derivation_output_id
WHERE derivation_inputs.derivation_id IN ("
- (string-join (map number->string ids) ",")
- ")")))
-
- (filter-map
- (lambda (row)
- (let ((number
- (string->number
- (car row))))
- (if (hash-ref seen-ids number)
- #f
- (begin
- (hash-set! seen-ids number #t)
-
- number))))
- (exec-query conn query))))
- (chunk! ids 500))
- <
- =))
-
- (define (derivation-ids->missing-sources ids)
- (define query
- (string-append
- "
+ (string-join (map number->string ids) ",")
+ ")")))
+
+ (filter-map
+ (lambda (row)
+ (let ((number
+ (string->number
+ (car row))))
+ (if (hash-ref seen-ids number)
+ #f
+ (begin
+ (hash-set! seen-ids number #t)
+
+ number))))
+ (exec-query conn query))))
+ (chunk! ids 500))
+ <
+ =))
+
+ (define (derivation-ids->missing-sources ids)
+ (define query
+ (string-append
+ "
SELECT derivation_sources.derivation_source_file_id, derivation_source_files.store_path
FROM derivation_sources
LEFT JOIN derivation_source_file_nars
@@ -1855,42 +1851,46 @@ INNER JOIN derivation_source_files
ON derivation_sources.derivation_source_file_id =
derivation_source_files.id
WHERE derivation_sources.derivation_id IN ("
- (string-join (map number->string ids) ", ")
- ")
+ (string-join (map number->string ids) ", ")
+ ")
AND derivation_source_file_nars.derivation_source_file_id IS NULL"))
- (map (lambda (row)
- (list (string->number (first row))
- (second row)))
- (exec-query conn query)))
-
- (let ((seen-ids (make-hash-table)))
- (let loop ((next-related-derivation-ids
- (derivation-ids->next-related-derivation-ids!
- (list-copy derivation-ids)
- seen-ids)))
- (unless (null? next-related-derivation-ids)
- (let ((missing-sources
- (append-map! derivation-ids->missing-sources
- (chunk next-related-derivation-ids
- 10000))))
-
- (unless (null? missing-sources)
- (with-time-logging
- (simple-format #f "inserting ~A missing source files"
- (length missing-sources))
- (for-each (match-lambda
- ((derivation-source-file-id store-path)
- (insert-derivation-source-file-nar
- conn
- derivation-source-file-id
- store-path)))
- missing-sources))))
-
- (loop
- (derivation-ids->next-related-derivation-ids!
- next-related-derivation-ids
- seen-ids))))))
+ (map (lambda (row)
+ (list (string->number (first row))
+ (second row)))
+ (exec-query conn query)))
+
+ (let ((seen-ids (make-hash-table)))
+ (let loop ((next-related-derivation-ids
+ (derivation-ids->next-related-derivation-ids!
+ (list-copy derivation-ids)
+ seen-ids)))
+ (unless (null? next-related-derivation-ids)
+ (let ((missing-sources
+ (append-map! derivation-ids->missing-sources
+ (chunk next-related-derivation-ids
+ 10000))))
+
+ (unless (null? missing-sources)
+ (with-time-logging
+ (simple-format #f "inserting ~A missing source files"
+ (length missing-sources))
+ (for-each (match-lambda
+ ((derivation-source-file-id store-path)
+ (insert-derivation-source-file-nar
+ conn
+ derivation-source-file-id
+ store-path)))
+ missing-sources))))
+
+ (loop
+ (derivation-ids->next-related-derivation-ids!
+ next-related-derivation-ids
+ seen-ids))))))
+
+(define (derivation-file-names->derivation-ids conn derivation-file-names)
+ (define derivations-count
+ (vector-length derivation-file-names))
(if (= 0 derivations-count)
#()
@@ -1951,17 +1951,6 @@ INNER JOIN derivation_source_files
#f))
derivation-file-names)))
- (with-time-logging "insert-source-files-missing-nars"
- (insert-source-files-missing-nars
- ;; TODO Avoid this conversion
- (vector-fold
- (lambda (_ result x)
- (if x
- (cons x result)
- result))
- '()
- all-ids)))
-
all-ids)))))
(define (update-derivation-inputs-statistics conn)