aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-12-15 21:52:30 +0000
committerChristopher Baines <mail@cbaines.net>2019-12-15 21:52:30 +0000
commitd29e17855ddf86f97a88f04cb35c3204c50521d1 (patch)
treee1663828a5c0bc48214b38b8f5817e230983446a
parent6c8ade12158cd2f4235834a17a9fe36cc9ac5f9e (diff)
downloaddata-service-d29e17855ddf86f97a88f04cb35c3204c50521d1.tar
data-service-d29e17855ddf86f97a88f04cb35c3204c50521d1.tar.gz
-rw-r--r--guix-data-service/model/nar.scm63
-rw-r--r--guix-data-service/web/revision/controller.scm29
-rw-r--r--guix-data-service/web/revision/html.scm235
3 files changed, 327 insertions, 0 deletions
diff --git a/guix-data-service/model/nar.scm b/guix-data-service/model/nar.scm
index b8e39e1..f3b94f0 100644
--- a/guix-data-service/model/nar.scm
+++ b/guix-data-service/model/nar.scm
@@ -13,6 +13,8 @@
select-nars-for-output
select-signing-key
+ select-reproducibility-status-for-revision
+
record-narinfo-details-and-return-ids))
(define narinfo-contents
@@ -217,6 +219,67 @@ VALUES ($1, $2)")
(list (list (cons "jsonb"
public-key-json-string)))))))
+(define (select-reproducibility-status-for-revision conn revision-commit)
+ (define query
+ "
+SELECT system, target, reproducible, COUNT(*)
+FROM (
+ SELECT derivation_output_details.path,
+ package_derivations.system,
+ package_derivations.target,
+ JSON_AGG(
+ json_build_object(
+ 'hash', nars.hash,
+ 'build_server_id', narinfo_fetch_records.build_server_id
+ )
+ ),
+ CASE
+ WHEN (COUNT(DISTINCT narinfo_fetch_records.build_server_id) <= 1) THEN NULL
+ ELSE (COUNT(DISTINCT nars.hash) = 1)
+ END AS reproducible
+ FROM derivation_output_details
+ INNER JOIN derivation_outputs
+ ON derivation_outputs.derivation_output_details_id =
+ derivation_output_details.id
+ INNER JOIN package_derivations
+ ON derivation_outputs.derivation_id = package_derivations.derivation_id
+ INNER JOIN guix_revision_package_derivations
+ ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
+ INNER JOIN guix_revisions
+ ON guix_revision_package_derivations.revision_id = guix_revisions.id
+ LEFT JOIN nars
+ ON derivation_output_details.path = nars.store_path
+ LEFT JOIN narinfo_signatures
+ ON narinfo_signatures.nar_id = nars.id
+ LEFT JOIN narinfo_signature_data
+ ON narinfo_signatures.narinfo_signature_data_id = narinfo_signature_data.id
+ LEFT JOIN narinfo_fetch_records
+ ON narinfo_fetch_records.narinfo_signature_data_id = narinfo_signature_data.id
+ WHERE derivation_output_details.hash IS NULL AND
+ guix_revisions.commit = $1 AND
+ package_derivations.system = package_derivations.target -- Exclude cross builds
+ GROUP BY derivation_output_details.path,
+ package_derivations.system,
+ package_derivations.target
+) data
+GROUP BY system, target, reproducible
+ORDER BY COUNT(*) DESC")
+
+ (group-to-alist
+ (match-lambda
+ ((system status count)
+ (cons system
+ (cons status count))))
+ (map (match-lambda
+ ((system target status count)
+ (list system
+ (match status
+ ("t" 'reproducible)
+ ("f" 'unreproducible)
+ ("" 'unknown))
+ (string->number count))))
+ (exec-query conn query (list revision-commit)))))
+
(define (select-outputs-for-successful-builds-without-known-nar-entries
conn
build-server-id
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index bc49703..5cb9623 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -43,6 +43,7 @@
#:use-module (guix-data-service model lint-checker)
#:use-module (guix-data-service model lint-warning)
#:use-module (guix-data-service model guix-revision)
+ #:use-module (guix-data-service model nar)
#:use-module (guix-data-service web revision html)
#:export (revision-controller
@@ -216,6 +217,15 @@
(render-unknown-revision mime-types
conn
commit-hash)))
+ (('GET "revision" commit-hash "package-reproducibility")
+ (if (guix-commit-exists? conn commit-hash)
+ (render-revision-package-reproduciblity mime-types
+ conn
+ commit-hash
+ #:path-base path)
+ (render-unknown-revision mime-types
+ conn
+ commit-hash)))
(('GET "revision" commit-hash "builds")
(if (guix-commit-exists? conn commit-hash)
(let ((parsed-query-parameters
@@ -330,6 +340,25 @@
#:header-text header-text)
#:extra-headers http-headers-for-unchanging-content)))))
+(define* (render-revision-package-reproduciblity mime-types
+ conn
+ commit-hash
+ #:key path-base)
+ (let ((reproducibility-status
+ (peek (select-reproducibility-status-for-revision conn commit-hash))))
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ '()))
+ (else
+ (render-html
+ #:sxml (view-revision-package-reproducibility
+ commit-hash
+ reproducibility-status
+ #:header-text '("Package reproducibility status")))))))
+
(define (render-revision-news mime-types
conn
commit-hash
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index ce79f52..b13ebf2 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -18,6 +18,7 @@
(define-module (guix-data-service web revision html)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:use-module (texinfo)
#:use-module (texinfo html)
#:use-module (json)
@@ -28,6 +29,7 @@
#:use-module (guix-data-service web view html)
#:export (view-revision-news
view-revision-package
+ view-revision-package-reproducibility
view-revision-package-and-version
view-revision
view-revision-packages
@@ -622,6 +624,239 @@
"Next page")))
'())))))
+(define* (view-revision-package-reproducibility revision-commit-hash
+ reproducibility-status
+ #:key path-base
+ header-text header-link)
+ (layout
+ #:body
+ `(,(header)
+ (style "
+.chart-text {
+ fill: #000;
+ -moz-transform: translateY(0.25em);
+ -ms-transform: translateY(0.25em);
+ -webkit-transform: translateY(0.25em);
+ transform: translateY(0.25em);
+}
+.chart-number {
+ font-size: 0.6em;
+ line-height: 1;
+ text-anchor: middle;
+ -moz-transform: translateY(-0.25em);
+ -ms-transform: translateY(-0.25em);
+ -webkit-transform: translateY(-0.25em);
+ transform: translateY(-0.25em);
+}
+.chart-label {
+ font-size: 0.2em;
+ text-anchor: middle;
+ -moz-transform: translateY(0.7em);
+ -ms-transform: translateY(0.7em);
+ -webkit-transform: translateY(0.7em);
+ transform: translateY(0.7em);
+}
+figure {
+ display: flex;
+ justify-content: space-around;
+ flex-direction: column;
+ margin-left: -15px;
+ margin-right: -15px;
+}
+@media (min-width: 768px) {
+ figure {
+ flex-direction: row;
+ }
+}
+.figure-content,
+.figure-key {
+ flex: 1;
+ padding-left: 15px;
+ padding-right: 15px;
+ align-self: center;
+}
+.figure-content svg {
+ height: auto;
+}
+.figure-key {
+ min-width: calc(8 / 12);
+}
+.figure-key [class*=\"shape-\"] {
+ margin-right: 6px;
+}
+.figure-key-list {
+ margin: 0;
+ padding: 0;
+ list-style: none;
+}
+.figure-key-list li {
+ margin: 0 0 8px;
+ padding: 0;
+}
+.shape-circle {
+ display: inline-block;
+ vertical-align: middle;
+ margin-right: 0.8em;
+ width: 32px;
+ height: 32px;
+ -webkit-border-radius: 50%;
+ -moz-border-radius: 50%;
+ border-radius: 50%;
+}")
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (h3 (a (@ (style "white-space: nowrap;")
+ (href ,header-link))
+ ,@header-text))))
+ (div
+ (@ (class "row"))
+
+ ;; Inspired by
+ ;; https://medium.com/@heyoka/scratch-made-svg-donut-pie-charts-in-html5-2c587e935d72
+
+ ,@(map
+ (match-lambda
+ ((system . reproducibility-status)
+
+ (define total
+ (apply + (map cdr reproducibility-status)))
+
+ (define keys
+ '(reproducible unreproducible unknown))
+
+ (define reproducibility-status-percentages
+ (map (lambda (key)
+ (exact->inexact
+ (* 100 (/ (or (assq-ref reproducibility-status key)
+ 0)
+ total))))
+ keys))
+
+
+ (peek system)
+ (peek reproducibility-status)
+
+ `(div
+ (@ (class "col-sm-6"))
+ (h2 (@ (style "font-family: monospace;"))
+ ,system)
+ (figure
+ (div
+ (@ (class "figure-content"))
+ (svg
+ (@ (width "100%") (height "100%") (viewBox "0 0 42 42") (class "donut")
+ (aria-labelledby "beers-title beers-desc") (role "img"))
+ (title
+ (@ (id "beers-title"))
+ "Beers in My Cellar")
+ (desc
+ (@ (id "beers-desc"))
+ "Donut chart showing 10 total beers. Two beers are Imperial India Pale Ales, four beers are Belgian Quadrupels, and three are Russian Imperial Stouts. The last remaining beer is unlabeled.")
+ (circle
+ (@ (class "donut-hole")
+ (cx "21")
+ (cy "21")
+ (r "15.91549430918954")
+ (fill "#fff")
+ (role "presentation")))
+ ;; (circle
+ ;; (@ (class "donut-ring")
+ ;; (cx "21")
+ ;; (cy "21")
+ ;; (r "15.91549430918954")
+ ;; (fill "transparent")
+ ;; (stroke "#000")
+ ;; (stroke-width "3")
+ ;; (role "presentation")))
+
+ ,@(map
+ (lambda (key colour percentage offset)
+ `(circle
+ (@ (class "donut-segment")
+ (cx "21")
+ (cy "21")
+ (r "15.91549430918954")
+ (fill "transparent")
+ (stroke ,colour)
+ (stroke-width "4")
+ (stroke-dasharray ,(simple-format #f "~A ~A"
+ percentage
+ (- 100 percentage)))
+ (stroke-dashoffset ,offset)
+ (aria-labelledby "donut-segment-1-title donut-segment-1-desc"))
+ (title
+ (@ (id "donut-segment-1-title"))
+ "Belgian Quadrupels")
+ (desc
+ (@ (id "donut-segment-1-desc"))
+ "Pink chart segment spanning 40% of the whole, which is 4 Belgian Quadrupels out of 10 total")))
+ '(reproducible unreproducible unknown)
+ '("green" "red" "#d2d3d4")
+ reproducibility-status-percentages
+ (cons 25
+ (map (lambda (cumalative-percentage)
+ (+ (- 100
+ cumalative-percentage)
+ ;; Start at 25, as this will position the segment at
+ ;; the top of the chart
+ 25))
+ (reverse
+ (fold (lambda (val result)
+ (cons (+ val (first result))
+ result))
+ (list (first reproducibility-status-percentages))
+ (cdr reproducibility-status-percentages))))))
+ (g
+ (@ (class "chart-text"))
+ ,@(if (and (eq? (or (assq-ref reproducibility-status 'reproducible)
+ 0)
+ 0)
+ (eq? (or (assq-ref reproducibility-status 'unreproducible)
+ 0)
+ 0))
+ `((text
+ (@ (x "50%") (y "50%") (class "chart-label"))
+ "No data"))
+ `((text
+ (@ (x "50%") (y "50%") (class "chart-number"))
+ ,(simple-format #f "~~~A%"
+ (inexact->exact
+ (round (car reproducibility-status-percentages)))))
+ (text
+ (@ (x "50%") (y "50%") (class "chart-label"))
+ "Reproducible"))))))
+ (figcaption
+ (@ (class "figure-key"))
+ (p (@ (class "sr-only"))
+ "Donut chart showing 10 total beers. Two beers are Imperial India
+Pale Ales, four beers are Belgian Quadrupels, and three are Russian Imperial
+Stouts. The last remaining beer is unlabeled.")
+
+ (ul
+ (@ (class "figure-key-list")
+ (aria-hidden "true")
+ (role "presentation"))
+ ,@(map (lambda (label count percentage colour)
+ `(li
+ (span (@ (class "shape-circle")
+ (style
+ ,(string-append "background-color: " colour ";"))))
+ ,(format #f "~a (~d, ~2,2f%)"
+ label
+ (or count 0)
+ (or percentage 0))))
+ '("Reproducible" "Unreproducible" "Unknown")
+ (map (lambda (key)
+ (assq-ref reproducibility-status key))
+ keys)
+ reproducibility-status-percentages
+ '("green" "red" "#d2d3d4"))))))))
+ reproducibility-status))))))
+
(define* (view-revision-derivations commit-hash
query-parameters
valid-systems