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

Avoid inserting duplicate nars

Browse source 
The nar_urls table has a unique index, so drop the ON CONFLICT DO NOTHING
bits.
This commit is contained in:
Christopher Baines 2025-11-13 11:15:19 +00:00
parent eb75964e76
commit b71214083d
1 changed files with 63 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

56
guix-data-service/model/nar.scm
View file

@ -18,6 +18,8 @@
(define-module (guix-data-service model nar) (define-module (guix-data-service model nar)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-43)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (web uri) #:use-module (web uri)
#:use-module (squee) #:use-module (squee)
@ -56,26 +58,36 @@
(or (narinfo-deriver narinfo) NULL))))) (or (narinfo-deriver narinfo) NULL)))))
narinfos)) narinfos))
(let ((nar-ids (let* ((nar-ids
(vector->list new-ids
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
"nars" "nars"
'(store_path hash_algorithm hash size system deriver) '(store_path hash_algorithm hash size system deriver)
(list->vector data))))) (list->vector data)))
(new-narinfos
(filter-map
(lambda (nar-id narinfo)
(if (vector-any (lambda (x)
(= x nar-id))
new-ids)
(cons nar-id narinfo)
#f))
(vector->list nar-ids)
narinfos)))
(let ((reference-data (let ((reference-data
(concatenate (concatenate
(map (lambda (nar-id narinfo) (map (match-lambda
((nar-id . narinfo)
(map (lambda (reference) (map (lambda (reference)
(simple-format (simple-format
#f #f
"(~A, ~A)" "(~A, ~A)"
nar-id nar-id
(quote-string reference))) (quote-string reference)))
(narinfo-references narinfo))) (narinfo-references narinfo))))
nar-ids new-narinfos))))
narinfos))))
(unless (null? reference-data) (unless (null? reference-data)
(exec-query (exec-query
conn conn
@ -83,9 +95,7 @@
" "
INSERT INTO nar_references (nar_id, reference) INSERT INTO nar_references (nar_id, reference)
VALUES " VALUES "
(string-join reference-data ", ") (string-join reference-data ", ")))))
"
ON CONFLICT DO NOTHING"))))
(exec-query (exec-query
conn conn
@ -95,7 +105,8 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size)
VALUES " VALUES "
(string-join (string-join
(concatenate (concatenate
(map (lambda (nar-id narinfo) (map (match-lambda
((nar-id . narinfo)
(map (lambda (uri compression file-size) (map (lambda (uri compression file-size)
(simple-format (simple-format
#f #f
@ -107,14 +118,12 @@ VALUES "
(or file-size "NULL"))) (or file-size "NULL")))
(narinfo-uris narinfo) (narinfo-uris narinfo)
(narinfo-compressions narinfo) (narinfo-compressions narinfo)
(narinfo-file-sizes narinfo))) (narinfo-file-sizes narinfo))))
nar-ids new-narinfos))
narinfos)) ", ")))
", ")
"
ON CONFLICT DO NOTHING"))
(for-each (lambda (nar-id narinfo) (for-each (match-lambda
((nar-id . narinfo)
(let ((narinfo-signature-data-id (let ((narinfo-signature-data-id
(narinfo-signature->data-id conn narinfo))) (narinfo-signature->data-id conn narinfo)))
@ -128,9 +137,7 @@ VALUES "
#f #f
"(~A,~A)" "(~A,~A)"
nar-id nar-id
narinfo-signature-data-id) narinfo-signature-data-id)))
"
ON CONFLICT DO NOTHING"))
(exec-query (exec-query
conn conn
@ -139,11 +146,10 @@ ON CONFLICT DO NOTHING"))
INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id) INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id)
VALUES ($1, $2)") VALUES ($1, $2)")
(list (number->string narinfo-signature-data-id) (list (number->string narinfo-signature-data-id)
(number->string build-server-id))))) (number->string build-server-id))))))
nar-ids new-narinfos)
narinfos)
nar-ids)) (vector->list nar-ids)))
(define (sexp->json-string sexp) (define (sexp->json-string sexp)
(define (transform x) (define (transform x)