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

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

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