From d29e17855ddf86f97a88f04cb35c3204c50521d1 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 15 Dec 2019 21:52:30 +0000 Subject: WIP --- guix-data-service/model/nar.scm | 63 +++++++ guix-data-service/web/revision/controller.scm | 29 ++++ guix-data-service/web/revision/html.scm | 235 ++++++++++++++++++++++++++ 3 files changed, 327 insertions(+) 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 -- cgit v1.2.3