Compare commits
No commits in common. "72fe3b4e473f07bddf2c268aa5886def8ca4b2de" and "0113843a7289ec76da54edb03c62da83a07244da" have entirely different histories.
72fe3b4e47
...
0113843a72
11 changed files with 382 additions and 369 deletions
|
|
@ -48,6 +48,10 @@
|
|||
NULL?
|
||||
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
|
||||
(make-parameter #f))
|
||||
|
||||
|
|
|
|||
|
|
@ -107,25 +107,25 @@ WHERE relname NOT LIKE 'package_derivations_by_guix_revision_range_git_branch_%'
|
|||
last-vacuum last-autovacuum last-analyze last-autoanalyze
|
||||
vacuum-count autovacuum-count analyze-count autoanalyze-count)
|
||||
`((name . ,relname)
|
||||
(seq-scan . ,(string->number seq-scan))
|
||||
(seq-tup-read . ,(string->number seq-tup-read))
|
||||
(idx-scan . ,(string->number idx-scan))
|
||||
(idx-tup-fetch . ,(string->number idx-tup-fetch))
|
||||
(n-tup-ins . ,(string->number n-tup-ins))
|
||||
(n-tup-upd . ,(string->number n-tup-upd))
|
||||
(n-tup-del . ,(string->number n-tup-del))
|
||||
(n-tup-hot-upd . ,(string->number n-tup-hot-upd))
|
||||
(n-live-tup . ,(string->number n-live-tup))
|
||||
(n-dead-tup . ,(string->number n-dead-tup))
|
||||
(n-mod-since-analyze . ,(string->number n-mod-since-analyze))
|
||||
(last-vacuum . ,(string->number last-vacuum))
|
||||
(last-autovacuum . ,(string->number last-autovacuum))
|
||||
(last-analyze . ,(string->number last-analyze))
|
||||
(last-autoanalyze . ,(string->number last-autoanalyze))
|
||||
(vacuum-count . ,(string->number vacuum-count))
|
||||
(autovacuum-count . ,(string->number autovacuum-count))
|
||||
(analyze-count . ,(string->number analyze-count))
|
||||
(autoanalyze-count . ,(string->number autoanalyze-count)))))
|
||||
(seq-scan . ,seq-scan)
|
||||
(seq-tup-read . ,seq-tup-read)
|
||||
(idx-scan . ,idx-scan)
|
||||
(idx-tup-fetch . ,idx-tup-fetch)
|
||||
(n-tup-ins . ,n-tup-ins)
|
||||
(n-tup-upd . ,n-tup-upd)
|
||||
(n-tup-del . ,n-tup-del)
|
||||
(n-tup-hot-upd . ,n-tup-hot-upd)
|
||||
(n-live-tup . ,n-live-tup)
|
||||
(n-dead-tup . ,n-dead-tup)
|
||||
(n-mod-since-analyze . ,n-mod-since-analyze)
|
||||
(last-vacuum . ,last-vacuum)
|
||||
(last-autovacuum . ,last-autovacuum)
|
||||
(last-analyze . ,last-analyze)
|
||||
(last-autoanalyze . ,last-autoanalyze)
|
||||
(vacuum-count . ,vacuum-count)
|
||||
(autovacuum-count . ,autovacuum-count)
|
||||
(analyze-count . ,analyze-count)
|
||||
(autoanalyze-count . ,autoanalyze-count))))
|
||||
(exec-query conn query)))
|
||||
|
||||
(define (fetch-pg-stat-user-indexes-metrics conn)
|
||||
|
|
@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service'
|
|||
`((name . ,indexname)
|
||||
(table-name . ,tablename)
|
||||
(tablespace . ,tablespace)
|
||||
(idx-scan . ,(string->number idx_scan))
|
||||
(idx-tup-read . ,(string->number idx_tup_read))
|
||||
(idx-tup-fetch . ,(string->number idx_tup_fetch))
|
||||
(bytes . ,(string->number size_in_bytes)))))
|
||||
(idx-scan . ,idx_scan)
|
||||
(idx-tup-read . ,idx_tup_read)
|
||||
(idx-tup-fetch . ,idx_tup_fetch)
|
||||
(bytes . ,size_in_bytes))))
|
||||
(exec-query conn query)))
|
||||
|
||||
(define (fetch-pg-stats-metrics conn)
|
||||
|
|
|
|||
|
|
@ -18,8 +18,6 @@
|
|||
(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)
|
||||
|
|
@ -58,36 +56,26 @@
|
|||
(or (narinfo-deriver narinfo) NULL)))))
|
||||
narinfos))
|
||||
|
||||
(let* ((nar-ids
|
||||
new-ids
|
||||
(let ((nar-ids
|
||||
(vector->list
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"nars"
|
||||
'(store_path hash_algorithm hash size system deriver)
|
||||
(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)))
|
||||
(list->vector data)))))
|
||||
|
||||
(let ((reference-data
|
||||
(concatenate
|
||||
(map (match-lambda
|
||||
((nar-id . narinfo)
|
||||
(map (lambda (nar-id narinfo)
|
||||
(map (lambda (reference)
|
||||
(simple-format
|
||||
#f
|
||||
"(~A, ~A)"
|
||||
nar-id
|
||||
(quote-string reference)))
|
||||
(narinfo-references narinfo))))
|
||||
new-narinfos))))
|
||||
(narinfo-references narinfo)))
|
||||
nar-ids
|
||||
narinfos))))
|
||||
(unless (null? reference-data)
|
||||
(exec-query
|
||||
conn
|
||||
|
|
@ -95,7 +83,9 @@
|
|||
"
|
||||
INSERT INTO nar_references (nar_id, reference)
|
||||
VALUES "
|
||||
(string-join reference-data ", ")))))
|
||||
(string-join reference-data ", ")
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
|
|
@ -105,8 +95,7 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size)
|
|||
VALUES "
|
||||
(string-join
|
||||
(concatenate
|
||||
(map (match-lambda
|
||||
((nar-id . narinfo)
|
||||
(map (lambda (nar-id narinfo)
|
||||
(map (lambda (uri compression file-size)
|
||||
(simple-format
|
||||
#f
|
||||
|
|
@ -118,12 +107,14 @@ VALUES "
|
|||
(or file-size "NULL")))
|
||||
(narinfo-uris narinfo)
|
||||
(narinfo-compressions narinfo)
|
||||
(narinfo-file-sizes narinfo))))
|
||||
new-narinfos))
|
||||
", ")))
|
||||
(narinfo-file-sizes narinfo)))
|
||||
nar-ids
|
||||
narinfos))
|
||||
", ")
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))
|
||||
|
||||
(for-each (match-lambda
|
||||
((nar-id . narinfo)
|
||||
(for-each (lambda (nar-id narinfo)
|
||||
(let ((narinfo-signature-data-id
|
||||
(narinfo-signature->data-id conn narinfo)))
|
||||
|
||||
|
|
@ -137,7 +128,9 @@ VALUES "
|
|||
#f
|
||||
"(~A,~A)"
|
||||
nar-id
|
||||
narinfo-signature-data-id)))
|
||||
narinfo-signature-data-id)
|
||||
"
|
||||
ON CONFLICT DO NOTHING"))
|
||||
|
||||
(exec-query
|
||||
conn
|
||||
|
|
@ -146,10 +139,11 @@ VALUES "
|
|||
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))))))
|
||||
new-narinfos)
|
||||
(number->string build-server-id)))))
|
||||
nar-ids
|
||||
narinfos)
|
||||
|
||||
(vector->list nar-ids)))
|
||||
nar-ids))
|
||||
|
||||
(define (sexp->json-string sexp)
|
||||
(define (transform x)
|
||||
|
|
|
|||
|
|
@ -628,7 +628,7 @@
|
|||
(render-html
|
||||
#:sxml (compare/derivation
|
||||
query-parameters
|
||||
#f))))
|
||||
'()))))
|
||||
|
||||
(let ((base-derivation (assq-ref query-parameters 'base_derivation))
|
||||
(target-derivation (assq-ref query-parameters 'target_derivation)))
|
||||
|
|
|
|||
|
|
@ -483,9 +483,7 @@
|
|||
"View JSON")))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
,@(if
|
||||
data
|
||||
`((div
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(h2 "Outputs")
|
||||
,@(let ((outputs (assq-ref data 'outputs)))
|
||||
|
|
@ -669,8 +667,7 @@
|
|||
(list target
|
||||
(display-possible-store-item
|
||||
target-value))))))))))))
|
||||
environment-variables))))))
|
||||
'()))))))
|
||||
environment-variables))))))))))
|
||||
|
||||
(define* (compare/package-derivations query-parameters
|
||||
mode
|
||||
|
|
|
|||
|
|
@ -347,13 +347,11 @@
|
|||
(for-each
|
||||
(match-lambda
|
||||
((stat . value)
|
||||
(and=> (assq-ref resource-pool-metrics stat)
|
||||
(lambda (metric)
|
||||
(metric-set
|
||||
metric
|
||||
(assq-ref resource-pool-metrics stat)
|
||||
value
|
||||
#:label-values
|
||||
`((pool_name . ,name)))))))
|
||||
`((pool_name . ,name)))))
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
(simple-format
|
||||
|
|
@ -498,8 +496,7 @@
|
|||
(render-html
|
||||
#:sxml (general-not-found
|
||||
"Derivation not found"
|
||||
"Derivations can differ, but produce the same outputs, so try querying by
|
||||
output, rather than derivation file name.")
|
||||
"No derivation found with this file name.")
|
||||
#:code 404))))
|
||||
|
||||
(define (render-json-derivation derivation-file-name)
|
||||
|
|
|
|||
|
|
@ -933,8 +933,7 @@
|
|||
|
||||
(define has-replacement? (assq-ref query-parameters 'has_replacement))
|
||||
|
||||
(fibers-let
|
||||
((metadata
|
||||
(fibers-let ((metadata
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-package-metadata-by-revision-name-and-version
|
||||
conn
|
||||
|
|
@ -993,12 +992,6 @@
|
|||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(if (null? metadata)
|
||||
(render-json
|
||||
`((name . ,name)
|
||||
(version . ,version)
|
||||
(error . "package not found"))
|
||||
#:code 404)
|
||||
(render-json
|
||||
`((name . ,name)
|
||||
(version . ,version)
|
||||
|
|
@ -1020,7 +1013,7 @@
|
|||
(derivation . ,file-name)
|
||||
(outputs . ,(list->vector outputs)))))
|
||||
derivations))))
|
||||
#:extra-headers http-headers-for-unchanging-content)))
|
||||
#:extra-headers http-headers-for-unchanging-content))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (view-revision-package-and-version commit-hash
|
||||
|
|
@ -1036,9 +1029,6 @@
|
|||
#:header-link header-link
|
||||
#:version-history-link
|
||||
version-history-link)
|
||||
#:code (if (null? metadata)
|
||||
404
|
||||
200)
|
||||
#:extra-headers http-headers-for-unchanging-content)))))
|
||||
|
||||
(define* (render-revision-package-derivations mime-types
|
||||
|
|
|
|||
|
|
@ -243,8 +243,6 @@
|
|||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
,(match package-metadata
|
||||
(()
|
||||
"Package not found at this version")
|
||||
(((synopsis synopsis-locale description description-locale home-page file line column-number
|
||||
licenses))
|
||||
`(dl
|
||||
|
|
|
|||
|
|
@ -325,8 +325,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
|
|||
(or (resource-pool-timeout-error? exn)
|
||||
(resource-pool-too-many-waiters-error? exn))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(text/html application/json)
|
||||
mime-types)
|
||||
mime-types
|
||||
'(text/html application/json))
|
||||
((application/json)
|
||||
(apply
|
||||
values
|
||||
|
|
|
|||
|
|
@ -33,8 +33,8 @@
|
|||
|
||||
uri-encode-filename))
|
||||
|
||||
(define (most-appropriate-mime-type supported-mime-types
|
||||
accepted-mime-types)
|
||||
(define (most-appropriate-mime-type accepted-mime-types
|
||||
supported-mime-types)
|
||||
(or
|
||||
;; Pick the first supported mime-type
|
||||
(find (lambda (accepted-mime-type)
|
||||
|
|
|
|||
33
guix-dev.scm
33
guix-dev.scm
|
|
@ -44,6 +44,39 @@
|
|||
(gnu packages ruby)
|
||||
(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
|
||||
(name "guix-data-service")
|
||||
(version "0.0.0")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue