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

Compare commits

base: cbaines:72fe3b4e473f07bddf2c268aa5886def8ca4b2de
Branches Tags
cbaines:trunk
cbaines:rework-revision-processing
..
compare: cbaines:0113843a7289ec76da54edb03c62da83a07244da
Branches Tags
cbaines:rework-revision-processing
cbaines:trunk

No commits in common. "72fe3b4e473f07bddf2c268aa5886def8ca4b2de" and "0113843a7289ec76da54edb03c62da83a07244da" have entirely different histories.
72fe3b4e47 ... 0113843a72

11 changed files with 382 additions and 369 deletions
Download patch file Download diff file Expand all files Collapse all files

4
guix-data-service/database.scm
View file

@ -48,6 +48,10 @@
NULL? NULL?
exec-query-with-null-handling)) exec-query-with-null-handling))
;; TODO This isn't exported for some reason
(define pg-conn-finish
(@@ (squee) pg-conn-finish))
(define %database-metrics-registry (define %database-metrics-registry
(make-parameter #f)) (make-parameter #f))

46
guix-data-service/metrics.scm
View file

@ -107,25 +107,25 @@ WHERE relname NOT LIKE 'package_derivations_by_guix_revision_range_git_branch_%'
last-vacuum last-autovacuum last-analyze last-autoanalyze last-vacuum last-autovacuum last-analyze last-autoanalyze
vacuum-count autovacuum-count analyze-count autoanalyze-count) vacuum-count autovacuum-count analyze-count autoanalyze-count)
`((name . ,relname) `((name . ,relname)
(seq-scan . ,(string->number seq-scan)) (seq-scan . ,seq-scan)
(seq-tup-read . ,(string->number seq-tup-read)) (seq-tup-read . ,seq-tup-read)
(idx-scan . ,(string->number idx-scan)) (idx-scan . ,idx-scan)
(idx-tup-fetch . ,(string->number idx-tup-fetch)) (idx-tup-fetch . ,idx-tup-fetch)
(n-tup-ins . ,(string->number n-tup-ins)) (n-tup-ins . ,n-tup-ins)
(n-tup-upd . ,(string->number n-tup-upd)) (n-tup-upd . ,n-tup-upd)
(n-tup-del . ,(string->number n-tup-del)) (n-tup-del . ,n-tup-del)
(n-tup-hot-upd . ,(string->number n-tup-hot-upd)) (n-tup-hot-upd . ,n-tup-hot-upd)
(n-live-tup . ,(string->number n-live-tup)) (n-live-tup . ,n-live-tup)
(n-dead-tup . ,(string->number n-dead-tup)) (n-dead-tup . ,n-dead-tup)
(n-mod-since-analyze . ,(string->number n-mod-since-analyze)) (n-mod-since-analyze . ,n-mod-since-analyze)
(last-vacuum . ,(string->number last-vacuum)) (last-vacuum . ,last-vacuum)
(last-autovacuum . ,(string->number last-autovacuum)) (last-autovacuum . ,last-autovacuum)
(last-analyze . ,(string->number last-analyze)) (last-analyze . ,last-analyze)
(last-autoanalyze . ,(string->number last-autoanalyze)) (last-autoanalyze . ,last-autoanalyze)
(vacuum-count . ,(string->number vacuum-count)) (vacuum-count . ,vacuum-count)
(autovacuum-count . ,(string->number autovacuum-count)) (autovacuum-count . ,autovacuum-count)
(analyze-count . ,(string->number analyze-count)) (analyze-count . ,analyze-count)
(autoanalyze-count . ,(string->number autoanalyze-count))))) (autoanalyze-count . ,autoanalyze-count))))
(exec-query conn query))) (exec-query conn query)))
(define (fetch-pg-stat-user-indexes-metrics conn) (define (fetch-pg-stat-user-indexes-metrics conn)
@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service'
`((name . ,indexname) `((name . ,indexname)
(table-name . ,tablename) (table-name . ,tablename)
(tablespace . ,tablespace) (tablespace . ,tablespace)
(idx-scan . ,(string->number idx_scan)) (idx-scan . ,idx_scan)
(idx-tup-read . ,(string->number idx_tup_read)) (idx-tup-read . ,idx_tup_read)
(idx-tup-fetch . ,(string->number idx_tup_fetch)) (idx-tup-fetch . ,idx_tup_fetch)
(bytes . ,(string->number size_in_bytes))))) (bytes . ,size_in_bytes))))
(exec-query conn query))) (exec-query conn query)))
(define (fetch-pg-stats-metrics conn) (define (fetch-pg-stats-metrics conn)

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

@ -18,8 +18,6 @@
(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)
@ -58,36 +56,26 @@
(or (narinfo-deriver narinfo) NULL))))) (or (narinfo-deriver narinfo) NULL)))))
narinfos)) narinfos))
(let* ((nar-ids (let ((nar-ids
new-ids (vector->list
(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 (match-lambda (map (lambda (nar-id narinfo)
((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)))
new-narinfos)))) nar-ids
narinfos))))
(unless (null? reference-data) (unless (null? reference-data)
(exec-query (exec-query
conn conn
@ -95,7 +83,9 @@
" "
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
@ -105,8 +95,7 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size)
VALUES " VALUES "
(string-join (string-join
(concatenate (concatenate
(map (match-lambda (map (lambda (nar-id narinfo)
((nar-id . narinfo)
(map (lambda (uri compression file-size) (map (lambda (uri compression file-size)
(simple-format (simple-format
#f #f
@ -118,12 +107,14 @@ 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)))
new-narinfos)) nar-ids
", "))) narinfos))
", ")
"
ON CONFLICT DO NOTHING"))
(for-each (match-lambda (for-each (lambda (nar-id narinfo)
((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)))
@ -137,7 +128,9 @@ 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
@ -146,10 +139,11 @@ VALUES "
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)))))
new-narinfos) nar-ids
narinfos)
(vector->list nar-ids))) nar-ids))
(define (sexp->json-string sexp) (define (sexp->json-string sexp)
(define (transform x) (define (transform x)

2
guix-data-service/web/compare/controller.scm
View file

@ -628,7 +628,7 @@
(render-html (render-html
#:sxml (compare/derivation #:sxml (compare/derivation
query-parameters query-parameters
#f)))) '()))))
(let ((base-derivation (assq-ref query-parameters 'base_derivation)) (let ((base-derivation (assq-ref query-parameters 'base_derivation))
(target-derivation (assq-ref query-parameters 'target_derivation))) (target-derivation (assq-ref query-parameters 'target_derivation)))

7
guix-data-service/web/compare/html.scm
View file

@ -483,9 +483,7 @@
"View JSON"))))) "View JSON")))))
(div (div
(@ (class "row")) (@ (class "row"))
,@(if (div
data
`((div
(@ (class "col-sm-12")) (@ (class "col-sm-12"))
(h2 "Outputs") (h2 "Outputs")
,@(let ((outputs (assq-ref data 'outputs))) ,@(let ((outputs (assq-ref data 'outputs)))
@ -669,8 +667,7 @@
(list target (list target
(display-possible-store-item (display-possible-store-item
target-value)))))))))))) target-value))))))))))))
environment-variables)))))) environment-variables))))))))))
'()))))))
(define* (compare/package-derivations query-parameters (define* (compare/package-derivations query-parameters
mode mode

9
guix-data-service/web/controller.scm
View file

@ -347,13 +347,11 @@
(for-each (for-each
(match-lambda (match-lambda
((stat . value) ((stat . value)
(and=> (assq-ref resource-pool-metrics stat)
(lambda (metric)
(metric-set (metric-set
metric (assq-ref resource-pool-metrics stat)
value value
#:label-values #:label-values
`((pool_name . ,name))))))) `((pool_name . ,name)))))
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(simple-format (simple-format
@ -498,8 +496,7 @@
(render-html (render-html
#:sxml (general-not-found #:sxml (general-not-found
"Derivation not found" "Derivation not found"
"Derivations can differ, but produce the same outputs, so try querying by "No derivation found with this file name.")
output, rather than derivation file name.")
#:code 404)))) #:code 404))))
(define (render-json-derivation derivation-file-name) (define (render-json-derivation derivation-file-name)

14
guix-data-service/web/revision/controller.scm
View file

@ -933,8 +933,7 @@
(define has-replacement? (assq-ref query-parameters 'has_replacement)) (define has-replacement? (assq-ref query-parameters 'has_replacement))
(fibers-let (fibers-let ((metadata
((metadata
(with-resource-from-pool (connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-package-metadata-by-revision-name-and-version (select-package-metadata-by-revision-name-and-version
conn conn
@ -993,12 +992,6 @@
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
((application/json) ((application/json)
(if (null? metadata)
(render-json
`((name . ,name)
(version . ,version)
(error . "package not found"))
#:code 404)
(render-json (render-json
`((name . ,name) `((name . ,name)
(version . ,version) (version . ,version)
@ -1020,7 +1013,7 @@
(derivation . ,file-name) (derivation . ,file-name)
(outputs . ,(list->vector outputs))))) (outputs . ,(list->vector outputs)))))
derivations)))) derivations))))
#:extra-headers http-headers-for-unchanging-content))) #:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (view-revision-package-and-version commit-hash #:sxml (view-revision-package-and-version commit-hash
@ -1036,9 +1029,6 @@
#:header-link header-link #:header-link header-link
#:version-history-link #:version-history-link
version-history-link) version-history-link)
#:code (if (null? metadata)
404
200)
#:extra-headers http-headers-for-unchanging-content))))) #:extra-headers http-headers-for-unchanging-content)))))
(define* (render-revision-package-derivations mime-types (define* (render-revision-package-derivations mime-types

2
guix-data-service/web/revision/html.scm
View file

@ -243,8 +243,6 @@
(div (div
(@ (class "col-sm-12")) (@ (class "col-sm-12"))
,(match package-metadata ,(match package-metadata
(()
"Package not found at this version")
(((synopsis synopsis-locale description description-locale home-page file line column-number (((synopsis synopsis-locale description description-locale home-page file line column-number
licenses)) licenses))
`(dl `(dl

4
guix-data-service/web/server.scm
View file

@ -325,8 +325,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
(or (resource-pool-timeout-error? exn) (or (resource-pool-timeout-error? exn)
(resource-pool-too-many-waiters-error? exn)))) (resource-pool-too-many-waiters-error? exn))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(text/html application/json) mime-types
mime-types) '(text/html application/json))
((application/json) ((application/json)
(apply (apply
values values

4
guix-data-service/web/util.scm
View file

@ -33,8 +33,8 @@
uri-encode-filename)) uri-encode-filename))
(define (most-appropriate-mime-type supported-mime-types (define (most-appropriate-mime-type accepted-mime-types
accepted-mime-types) supported-mime-types)
(or (or
;; Pick the first supported mime-type ;; Pick the first supported mime-type
(find (lambda (accepted-mime-type) (find (lambda (accepted-mime-type)

33
guix-dev.scm
View file

@ -44,6 +44,39 @@
(gnu packages ruby) (gnu packages ruby)
(srfi srfi-1)) (srfi srfi-1))
(define guile-knots
(let ((commit "d18b5b8d5de5beff3b9f84cfb359b73a4dcf2070")
(revision "1"))
(package
(name "guile-knots")
(version (git-version "0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.cbaines.net/git/guile/knots")
(commit commit)))
(sha256
(base32
"0ygf0m6y6mf53pgq5i7agv4a54fkml2akg3ws55jj79v5ndy3lnb"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
(native-inputs
(list pkg-config
autoconf
automake
guile-next
guile-lib
guile-fibers-next))
(inputs
(list guile-next))
(propagated-inputs
(list guile-fibers-next))
(home-page "https://git.cbaines.net/guile/knots")
(synopsis "Patterns and functionality to use with Guile Fibers")
(description
"")
(license license:gpl3+))))
(package (package
(name "guix-data-service") (name "guix-data-service")
(version "0.0.0") (version "0.0.0")