;;; Guix Data Service -- Information about Guix over time ;;; Copyright © 2019 Christopher Baines ;;; ;;; This program is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU Affero General Public License ;;; as published by the Free Software Foundation, either version 3 of ;;; the License, or (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Affero General Public License for more details. ;;; ;;; You should have received a copy of the GNU Affero General Public ;;; License along with this program. If not, see ;;; . (define-module (guix-data-service comparison) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (ice-9 vlist) #:use-module (ice-9 match) #:use-module (squee) #:use-module (json) #:use-module (guix-data-service database) #:use-module (guix-data-service model utils) #:use-module (guix-data-service model derivation) #:export (derivation-differences-data package-differences-data package-data->package-data-vhashes package-data-vhashes->new-packages package-data-vhashes->removed-packages package-data-version-changes package-derivation-differences-data package-derivation-data->package-derivation-data-vhashes package-derivation-data->names-and-versions package-derivation-data-vhash->derivations package-derivation-data-vhash->derivations-and-build-status package-derivation-data-changes lint-warning-differences-data system-test-derivations-differences-data channel-news-differences-data)) (define (derivation-differences-data conn base-derivation-file-name target-derivation-file-name) (define base-derivation (select-derivation-by-file-name conn base-derivation-file-name)) (define target-derivation (select-derivation-by-file-name conn target-derivation-file-name)) (define group-by-last-element (lambda (vals) (let ((groups (last vals))) (cons (if (eq? (length groups) 2) 'common (first groups)) (drop-right vals 1))))) (define (fetch-value alist key) (assq-ref (find (lambda (env-var) (if (string=? key (assq-ref env-var 'key)) (assq-ref env-var 'value) #f)) alist) 'value)) `((outputs . ,(group-to-alist/vector group-by-last-element (derivation-outputs-differences-data conn (first base-derivation) (first target-derivation)))) (inputs . ,(group-to-alist/vector group-by-last-element (derivation-inputs-differences-data conn (first base-derivation) (first target-derivation)))) (sources . ,(group-to-alist/vector group-by-last-element (derivation-sources-differences-data conn (first base-derivation) (first target-derivation)))) ,@(match base-derivation ((_ _ base-builder base-args base-env-vars base-system) (match target-derivation ((_ _ target-builder target-args target-env-vars target-system) `((system . ,(if (string=? base-system target-system) `((common . ,base-system)) `((base . ,base-system) (target . ,target-system)))) (builder . ,(if (string=? base-builder target-builder) `((common . ,base-builder)) `((base . ,base-builder) (target . ,target-builder)))) (arguments . ,(if (eq? base-args target-args) `((common . ,(list->vector base-args))) `((base . ,(list->vector base-args)) (target . ,(list->vector target-args))))) (environment-variables . ,(map (lambda (key) (let ((base-value (fetch-value base-env-vars key)) (target-value (fetch-value target-env-vars key))) (if (and base-value target-value) `(,key . ,(if (string=? base-value target-value) `((common . ,base-value)) `((base . ,base-value) (target . ,target-value)))) (if base-value `(,key . ((base . ,base-value))) `(,key . ((target . ,target-value))))))) (delete-duplicates (map (lambda (env-var) (assq-ref env-var 'key)) (append base-env-vars target-env-vars)) string=?)))))))))) (define (derivation-outputs-differences-data conn base-derivation-id target-derivation-id) (define query (string-append " SELECT derivation_outputs.name, derivation_output_details.path, derivation_output_details.hash_algorithm, derivation_output_details.hash, derivation_output_details.recursive, ARRAY_AGG(derivation_outputs.derivation_id) AS derivation_ids FROM derivation_outputs INNER JOIN derivation_output_details ON derivation_output_details_id = derivation_output_details.id WHERE derivation_outputs.derivation_id IN (" (simple-format #f "~A,~A" base-derivation-id target-derivation-id) " ) GROUP BY 1, 2, 3, 4, 5")) (map (match-lambda ((output-name path hash-algorithm hash recursive derivation_ids) (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) `((output-name . ,output-name) (path . ,path) ,@(if (string? hash-algorithm) `((hash-algorithm . ,hash-algorithm)) `((hash-algorithm . null))) ,@(if (string? hash) `((hash . ,hash)) `((hash . null))) (recursive . ,(string=? recursive "t")) ,(append (if (memq base-derivation-id parsed-derivation-ids) '(base) '()) (if (memq target-derivation-id parsed-derivation-ids) '(target) '())))))) (exec-query conn query))) (define (derivation-inputs-differences-data conn base-derivation-id target-derivation-id) (define query (string-append " SELECT derivations.file_name, derivation_outputs.name, relevant_derivation_inputs.derivation_ids FROM derivation_outputs INNER JOIN ( SELECT derivation_output_id, ARRAY_AGG(derivation_id) AS derivation_ids FROM derivation_inputs WHERE derivation_id IN (" (simple-format #f "~A,~A" base-derivation-id target-derivation-id) ") GROUP BY derivation_output_id ) AS relevant_derivation_inputs ON derivation_outputs.id = relevant_derivation_inputs.derivation_output_id INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id ")) (map (match-lambda ((derivation_file_name derivation_output_name derivation_ids) (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) `((derivation_file_name . ,derivation_file_name) (derivation_output_name . ,derivation_output_name) ,(append (if (memq base-derivation-id parsed-derivation-ids) '(base) '()) (if (memq target-derivation-id parsed-derivation-ids) '(target) '())))))) (exec-query conn query))) (define (derivation-sources-differences-data conn base-derivation-id target-derivation-id) (define query (string-append " SELECT derivation_source_files.store_path, ARRAY_AGG(derivation_sources.derivation_id) FROM derivation_source_files INNER JOIN derivation_sources ON derivation_source_files.id = derivation_sources.derivation_source_file_id WHERE derivation_sources.derivation_id IN (" (simple-format #f "~A,~A" base-derivation-id target-derivation-id) ") GROUP BY derivation_source_files.store_path")) (map (match-lambda ((store_path derivation_ids) (let ((parsed-derivation-ids (map string->number (parse-postgresql-array-string derivation_ids)))) `((store_path . ,store_path) ,(append (if (memq base-derivation-id parsed-derivation-ids) '(base) '()) (if (memq target-derivation-id parsed-derivation-ids) '(target) '())))))) (exec-query conn query))) (define* (package-derivation-differences-data conn base_guix_revision_id target_guix_revision_id #:key (systems #f) (targets #f) (include-builds? #t) (exclude-unchanged-outputs? #t) ;; Build changes are (symbols): ;; broken, fixed, still-failing, ;; still-working, unknown (build-change 'unknown) limit-results after-name) (define extra-constraints (string-append (if systems (string-append " AND systems.system IN (" (string-join (map (lambda (s) (string-append "'" s "'")) systems) ", ") ")") "") (if targets (string-append " AND package_derivations.target IN (" (string-join (map (lambda (s) (string-append "'" s "'")) targets) ", ") ")") ""))) (define query (string-append " WITH base_packages AS ( SELECT packages.*, derivations.id AS derivation_id, derivations.file_name, systems.system, package_derivations.target, derivations_by_output_details_set.derivation_output_details_set_id FROM packages INNER JOIN package_derivations ON packages.id = package_derivations.package_id INNER JOIN systems ON package_derivations.system_id = systems.id INNER JOIN derivations ON package_derivations.derivation_id = derivations.id INNER JOIN derivations_by_output_details_set ON derivations.id = derivations_by_output_details_set.derivation_id WHERE package_derivations.id IN ( SELECT guix_revision_package_derivations.package_derivation_id FROM guix_revision_package_derivations WHERE revision_id = $1 )" extra-constraints " ), target_packages AS ( SELECT packages.*, derivations.id AS derivation_id, derivations.file_name, systems.system, package_derivations.target, derivations_by_output_details_set.derivation_output_details_set_id FROM packages INNER JOIN package_derivations ON packages.id = package_derivations.package_id INNER JOIN systems ON package_derivations.system_id = systems.id INNER JOIN derivations ON package_derivations.derivation_id = derivations.id INNER JOIN derivations_by_output_details_set ON derivations.id = derivations_by_output_details_set.derivation_id WHERE package_derivations.id IN ( SELECT guix_revision_package_derivations.package_derivation_id FROM guix_revision_package_derivations WHERE revision_id = $2 )" extra-constraints " ) SELECT base_packages.name, base_packages.version, base_packages.package_metadata_id, base_packages.file_name, base_packages.system, base_packages.target," (if include-builds? " ( SELECT JSON_AGG( json_build_object( 'build_server_id', builds.build_server_id, 'build_server_build_id', builds.build_server_build_id, 'status', latest_build_status.status, 'timestamp', latest_build_status.timestamp, 'build_for_equivalent_derivation', builds.derivation_file_name != base_packages.file_name, 'potentially_blocked', EXISTS ( SELECT 1 FROM blocked_builds WHERE blocked_derivation_output_details_set_id = base_packages.derivation_output_details_set_id ) ) ORDER BY latest_build_status.timestamp ) FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = base_packages.derivation_output_details_set_id ) AS base_builds," "") " target_packages.name, target_packages.version, target_packages.package_metadata_id, target_packages.file_name, target_packages.system, target_packages.target" (if include-builds? ", ( SELECT JSON_AGG( json_build_object( 'build_server_id', builds.build_server_id, 'build_server_build_id', builds.build_server_build_id, 'status', latest_build_status.status, 'timestamp', latest_build_status.timestamp, 'build_for_equivalent_derivation', builds.derivation_file_name != target_packages.file_name, 'potentially_blocked', EXISTS ( SELECT 1 FROM blocked_builds WHERE blocked_derivation_output_details_set_id = target_packages.derivation_output_details_set_id ) ) ORDER BY latest_build_status.timestamp ) FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = target_packages.derivation_output_details_set_id ) AS target_builds" "") " FROM base_packages FULL OUTER JOIN target_packages ON base_packages.name = target_packages.name AND base_packages.version = target_packages.version AND base_packages.system = target_packages.system AND base_packages.target = target_packages.target WHERE ( base_packages.id IS NULL OR target_packages.id IS NULL OR base_packages.file_name != target_packages.file_name )" (if after-name " AND coalesce(base_packages.name, target_packages.name) > $3" "") (if exclude-unchanged-outputs? " AND ( ( base_packages.derivation_output_details_set_id IS NULL OR target_packages.derivation_output_details_set_id IS NULL ) OR ( base_packages.derivation_output_details_set_id <> target_packages.derivation_output_details_set_id ) ) " "") (cond ((eq? build-change #f) "") ((eq? build-change 'unknown) " AND ( ( base_packages.id IS NULL OR target_packages.id IS NULL ) OR ( NOT EXISTS ( SELECT 1 FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = base_packages.derivation_output_details_set_id AND ( latest_build_status.status = 'succeeded' OR latest_build_status.status = 'failed' ) ) AND NOT EXISTS ( SELECT 1 FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = target_packages.derivation_output_details_set_id AND ( latest_build_status.status = 'succeeded' OR latest_build_status.status = 'failed' ) ) ) )") (else (let ((exists-build-with-status (lambda (base-or-target status) (simple-format #f "EXISTS ( SELECT 1 FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = ~A_packages.derivation_output_details_set_id AND latest_build_status.status = '~A' ) " base-or-target status))) (not-exists-build-with-status (lambda (base-or-target status) (simple-format #f "NOT EXISTS ( SELECT 1 FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = ~A_packages.derivation_output_details_set_id AND latest_build_status.status = '~A' ) " base-or-target status))) (criteria (lambda args (string-append "\n AND " (string-join args " \nAND\n "))))) (string-append " AND base_packages.id IS NOT NULL AND target_packages.id IS NOT NULL" (cond ((eq? build-change 'broken) (criteria (exists-build-with-status "base" "succeeded") (exists-build-with-status "target" "failed") (not-exists-build-with-status "target" "succeeded"))) ((eq? build-change 'fixed) (criteria (exists-build-with-status "base" "failed") (not-exists-build-with-status "base" "succeeded") (exists-build-with-status "target" "succeeded"))) ((eq? build-change 'still-failing) (criteria (not-exists-build-with-status "base" "succeeded") (exists-build-with-status "base" "failed") (not-exists-build-with-status "target" "succeeded") (exists-build-with-status "target" "failed"))) ((eq? build-change 'still-working) (criteria (exists-build-with-status "base" "succeeded") (exists-build-with-status "target" "succeeded"))) (else (error "unknown build-change-value"))))))) " ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.version, target_packages.version" (if limit-results (simple-format #f " LIMIT ~A" (number->string limit-results)) ""))) (exec-query conn query `(,base_guix_revision_id ,target_guix_revision_id ,@(if after-name (list after-name) '())))) (define* (package-differences-data conn base_guix_revision_id target_guix_revision_id) (define query (string-append " WITH base_packages AS ( SELECT * FROM packages WHERE id IN ( SELECT package_id FROM package_derivations INNER JOIN guix_revision_package_derivations ON package_derivations.id = guix_revision_package_derivations.package_derivation_id WHERE guix_revision_package_derivations.revision_id = $1 ) ), target_packages AS ( SELECT * FROM packages WHERE id IN ( SELECT package_id FROM package_derivations INNER JOIN guix_revision_package_derivations ON package_derivations.id = guix_revision_package_derivations.package_derivation_id WHERE guix_revision_package_derivations.revision_id = $2 ) ) SELECT base_packages.name, base_packages.version, base_packages.package_metadata_id, target_packages.name, target_packages.version, target_packages.package_metadata_id FROM base_packages FULL OUTER JOIN target_packages ON base_packages.name = target_packages.name AND base_packages.version = target_packages.version WHERE base_packages.id IS NULL OR target_packages.id IS NULL OR base_packages.id != target_packages.id ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.version, target_packages.version")) (exec-query conn query (list base_guix_revision_id target_guix_revision_id))) (define (package-data->package-data-vhashes package-data) (define (add-data-to-vhash data vhash) (let ((key (first data))) (if (or (eq? #f key) (string-null? key)) vhash (vhash-cons key (drop data 1) vhash)))) (apply values (fold (lambda (row result) (let-values (((base-row-part target-row-part) (split-at row 3))) (match result ((base-package-data target-package-data) (list (add-data-to-vhash base-row-part base-package-data) (add-data-to-vhash target-row-part target-package-data)))))) (list vlist-null vlist-null) package-data))) (define (package-derivation-data->package-derivation-data-vhashes package-data) (define (add-data-to-vhash data vhash) (let ((key (first data))) (if (or (eq? key #f) (string-null? key)) vhash (vhash-cons key (drop data 1) vhash)))) (apply values (fold (lambda (row result) (let-values (((base-row-part target-row-part) (split-at row 7))) (match result ((base-package-data target-package-data) (list (add-data-to-vhash base-row-part base-package-data) (add-data-to-vhash target-row-part target-package-data)))))) (list vlist-null vlist-null) package-data))) (define (package-derivation-data->names-and-versions package-data) (reverse (pair-fold (lambda (pair result) (match pair (((name . version)) (cons (cons name version) result)) (((name1 . version1) (name2 . version2) rest ...) (if (and (string=? name1 name2) (string=? version1 version2)) result (cons (cons name1 version1) result))))) '() (map (match-lambda ((base-name base-version _ _ _ _ _ target-name target-version _ _ _ _ _) (if (or (and (string? base-name) (string-null? base-name)) (eq? base-name #f)) (cons target-name target-version) (cons base-name base-version)))) package-data)))) (define (package-derivation-data-vhash->derivations conn packages-vhash) (define (vhash->derivation-ids vhash) (vhash-fold (lambda (key value result) (cons (third value) result)) '() vhash)) (let* ((derivation-ids (vhash->derivation-ids packages-vhash)) (derivation-data (select-derivations-by-id conn derivation-ids))) derivation-data)) (define (package-derivation-data-vhash->derivations-and-build-status conn package-derivation-data-vhash systems targets build-statuses) (define (vhash->derivation-file-names vhash) (vhash-fold (lambda (key value result) (cons (third value) result)) '() vhash)) (let* ((derivation-file-names (vhash->derivation-file-names package-derivation-data-vhash))) (if (null? derivation-file-names) '() (select-derivations-and-build-status conn #:file-names derivation-file-names #:systems (if (null? systems) #f systems) #:targets (if (null? targets) #f targets) #:build-statuses (if (null? build-statuses) #f build-statuses))))) (define (package-data-vhash->package-name-and-version-hash-table vhash) (vhash-fold (lambda (name details result) (let ((key (cons name (first details)))) (hash-set! result key (cons (cdr details) (or (hash-ref result key) '()))) result)) (make-hash-table) vhash)) (define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash) (hash-map->list (match-lambda* (((name . version) metadata ...) `((name . ,name) (version . ,version)))) (package-data-vhash->package-name-and-version-hash-table (vlist-filter (match-lambda ((name . details) (not (vhash-assoc name base-packages-vhash)))) target-packages-vhash)))) (define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash) (hash-map->list (match-lambda* (((name . version) metadata ...) `((name . ,name) (version . ,version)))) (package-data-vhash->package-name-and-version-hash-table (vlist-filter (match-lambda ((name . details) (not (vhash-assoc name target-packages-vhash)))) base-packages-vhash)))) (define (package-data-vhash->package-versions-hash-table package-data-vhash) (vhash-fold (lambda (name details result) (let ((version (first details)) (known-versions (or (hash-ref result name) '()))) (hash-set! result name (cons version known-versions)) result)) (make-hash-table) package-data-vhash)) (define (package-data-version-changes base-packages-vhash target-packages-vhash) (let ((base-versions (package-data-vhash->package-versions-hash-table base-packages-vhash)) (target-versions (package-data-vhash->package-versions-hash-table target-packages-vhash))) (hash-fold (lambda (name target-versions result) (let ((base-versions (hash-ref base-versions name))) (if base-versions (let ((base-version-numbers base-versions) (target-version-numbers target-versions)) (if (equal? base-version-numbers target-version-numbers) result (cons `(,name . ((base . ,(list->vector base-version-numbers)) (target . ,(list->vector target-version-numbers)))) result))) result))) '() target-versions))) (define (package-derivation-data-changes names-and-versions base-packages-vhash target-packages-vhash) (define base-package-details-by-name-and-version (package-data-vhash->package-name-and-version-hash-table base-packages-vhash)) (define target-package-details-by-name-and-version (package-data-vhash->package-name-and-version-hash-table target-packages-vhash)) (define (derivation-system-and-target-list->alist lst) (if (null? lst) '() `(,(match (first lst) ((derivation-file-name system target builds) `((system . ,system) (target . ,target) (derivation-file-name . ,derivation-file-name) (builds . ,(if (or (and (string? builds) (string-null? builds)) (eq? #f builds)) #() (json-string->scm builds)))))) ,@(derivation-system-and-target-list->alist (cdr lst))))) (list->vector (filter-map (lambda (name-and-version) (let ((base-packages-entry (hash-ref base-package-details-by-name-and-version name-and-version)) (target-packages-entry (hash-ref target-package-details-by-name-and-version name-and-version))) (cond ((and base-packages-entry target-packages-entry) (let ((base-derivations (map cdr base-packages-entry)) (target-derivations (map cdr target-packages-entry))) (if (equal? base-derivations target-derivations) #f `((name . ,(car name-and-version)) (version . ,(cdr name-and-version)) (base . ,(list->vector (derivation-system-and-target-list->alist base-derivations))) (target . ,(list->vector (derivation-system-and-target-list->alist target-derivations))))))) (base-packages-entry (let ((base-derivations (map cdr base-packages-entry))) `((name . ,(car name-and-version)) (version . ,(cdr name-and-version)) (base . ,(list->vector (derivation-system-and-target-list->alist base-derivations))) (target . ,(list->vector '()))))) (else (let ((target-derivations (map cdr target-packages-entry))) `((name . ,(car name-and-version)) (version . ,(cdr name-and-version)) (base . ,(list->vector '())) (target . ,(list->vector (derivation-system-and-target-list->alist target-derivations))))))))) names-and-versions))) (define* (lint-warning-differences-data conn base-guix-revision-id target-guix-revision-id locale) (define query (string-append " WITH base_lint_warnings AS ( SELECT DISTINCT ON (lint_warnings.id) lint_warnings.id, packages.name, packages.version, lint_checkers.name AS lint_checker_name, translated_lint_checker_descriptions.description AS lint_checker_description, lint_checkers.network_dependent AS lint_checker_network_dependent, locations.file, locations.line, locations.column_number, lint_warning_messages.message, lint_warning_messages.locale AS lint_warning_messages_locale, translated_lint_checker_descriptions.locale AS lint_checker_descriptions_locale FROM lint_warnings INNER JOIN packages ON lint_warnings.package_id = packages.id INNER JOIN lint_checkers ON lint_warnings.lint_checker_id = lint_checkers.id INNER JOIN ( SELECT DISTINCT ON(lint_checkers.id) lint_checkers.id AS lint_checker_id, lint_checker_descriptions.description, lint_checker_descriptions.locale FROM lint_checkers INNER JOIN lint_checker_description_sets ON lint_checker_description_sets.id = lint_checkers.lint_checker_description_set_id INNER JOIN lint_checker_descriptions ON lint_checker_descriptions.id = ANY (lint_checker_description_sets.description_ids) INNER JOIN guix_revision_lint_checkers ON lint_checkers.id = guix_revision_lint_checkers.lint_checker_id AND guix_revision_lint_checkers.guix_revision_id = $1 ORDER BY lint_checkers.id, CASE WHEN lint_checker_descriptions.locale = $3 THEN 2 WHEN lint_checker_descriptions.locale = 'en_US.UTF-8' THEN 1 ELSE 0 END DESC ) AS translated_lint_checker_descriptions ON translated_lint_checker_descriptions.lint_checker_id = lint_checkers.id INNER JOIN locations ON lint_warnings.location_id = locations.id INNER JOIN lint_warning_message_sets ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id INNER JOIN lint_warning_messages ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids) WHERE lint_warnings.id IN ( SELECT lint_warning_id FROM guix_revision_lint_warnings WHERE guix_revision_id = $1 ) ORDER BY lint_warnings.id, CASE WHEN lint_warning_messages.locale = $3 THEN 2 WHEN lint_warning_messages.locale = 'en_US.UTF-8' THEN 1 ELSE 0 END DESC ), target_lint_warnings AS ( SELECT DISTINCT ON (lint_warnings.id) lint_warnings.id, packages.name, packages.version, lint_checkers.name AS lint_checker_name, translated_lint_checker_descriptions.description AS lint_checker_description, lint_checkers.network_dependent AS lint_checker_network_dependent, locations.file, locations.line, locations.column_number, lint_warning_messages.message, translated_lint_checker_descriptions.locale AS lint_checker_descriptions_locale FROM lint_warnings INNER JOIN packages ON lint_warnings.package_id = packages.id INNER JOIN lint_checkers ON lint_warnings.lint_checker_id = lint_checkers.id INNER JOIN ( SELECT DISTINCT ON(lint_checkers.id) lint_checkers.id AS lint_checker_id, lint_checker_descriptions.description description, lint_checker_descriptions.locale FROM lint_checkers INNER JOIN lint_checker_description_sets ON lint_checker_description_sets.id = lint_checkers.lint_checker_description_set_id INNER JOIN lint_checker_descriptions ON lint_checker_descriptions.id = ANY (lint_checker_description_sets.description_ids) INNER JOIN guix_revision_lint_checkers ON lint_checkers.id = guix_revision_lint_checkers.lint_checker_id AND guix_revision_lint_checkers.guix_revision_id = $2 ORDER BY lint_checkers.id, CASE WHEN lint_checker_descriptions.locale = $3 THEN 2 WHEN lint_checker_descriptions.locale = 'en_US.UTF-8' THEN 1 ELSE 0 END DESC ) AS translated_lint_checker_descriptions ON translated_lint_checker_descriptions.lint_checker_id = lint_checkers.id INNER JOIN locations ON lint_warnings.location_id = locations.id INNER JOIN lint_warning_message_sets ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id INNER JOIN lint_warning_messages ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids) WHERE lint_warnings.id IN ( SELECT lint_warning_id FROM guix_revision_lint_warnings WHERE guix_revision_id = $2 ) ORDER BY lint_warnings.id, CASE WHEN lint_warning_messages.locale = $3 THEN 2 WHEN lint_warning_messages.locale = 'en_US.UTF-8' THEN 1 ELSE 0 END DESC ) SELECT coalesce( base_lint_warnings.name, target_lint_warnings.name ) AS package_name, coalesce( base_lint_warnings.version, target_lint_warnings.version ) AS package_version, coalesce( base_lint_warnings.lint_checker_name, target_lint_warnings.lint_checker_name ) AS lint_checker_name, coalesce( base_lint_warnings.message, target_lint_warnings.message ) AS message, coalesce( base_lint_warnings.lint_checker_description, target_lint_warnings.lint_checker_description ) AS lint_checker_description, coalesce( base_lint_warnings.lint_checker_network_dependent, target_lint_warnings.lint_checker_network_dependent ) AS lint_checker_network_dependent, coalesce( base_lint_warnings.file, target_lint_warnings.file ) AS file, coalesce( base_lint_warnings.line, target_lint_warnings.line ) AS line, coalesce( base_lint_warnings.column_number, target_lint_warnings.column_number ) AS column_number, CASE WHEN base_lint_warnings.name IS NULL THEN 'new' WHEN target_lint_warnings.name IS NULL THEN 'removed' ELSE 'moved' END AS change FROM base_lint_warnings FULL OUTER JOIN target_lint_warnings ON base_lint_warnings.name = target_lint_warnings.name AND base_lint_warnings.lint_checker_name = target_lint_warnings.lint_checker_name AND ( base_lint_warnings.message = target_lint_warnings.message OR -- TODO Some lint warnings include the line number in the message, so -- they'll appear to be altered if the package definition moves within the -- file, therefore try replacing the line number to see if the message matches -- that way as well replace(base_lint_warnings.message,base_lint_warnings.line::varchar,target_lint_warnings.line::varchar) = target_lint_warnings.message ) WHERE ( base_lint_warnings.id IS NULL OR target_lint_warnings.id IS NULL OR base_lint_warnings.id != target_lint_warnings.id ) AND ( base_lint_warnings.name IS NULL OR target_lint_warnings.name IS NULL ) ORDER BY coalesce(base_lint_warnings.name, target_lint_warnings.name) ASC, base_lint_warnings.version, target_lint_warnings.version, change")) (exec-query conn query (list base-guix-revision-id target-guix-revision-id locale))) (define* (system-test-derivations-differences-data conn base_guix_revision_id target_guix_revision_id system) (define query (string-append " WITH base_system_tests AS ( SELECT name, description, derivations.file_name AS derivation_file_name, derivation_output_details_set_id, locations.file, locations.line, locations.column_number FROM guix_revision_system_test_derivations INNER JOIN system_tests ON guix_revision_system_test_derivations.system_test_id = system_tests.id INNER JOIN locations ON system_tests.location_id = locations.id INNER JOIN derivations ON guix_revision_system_test_derivations.derivation_id = derivations.id INNER JOIN derivations_by_output_details_set ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id WHERE guix_revision_id = $1 AND guix_revision_system_test_derivations.system = $3 ), target_system_tests AS ( SELECT name, description, derivations.file_name AS derivation_file_name, derivation_output_details_set_id, locations.file, locations.line, locations.column_number FROM guix_revision_system_test_derivations INNER JOIN system_tests ON guix_revision_system_test_derivations.system_test_id = system_tests.id INNER JOIN locations ON system_tests.location_id = locations.id INNER JOIN derivations ON guix_revision_system_test_derivations.derivation_id = derivations.id INNER JOIN derivations_by_output_details_set ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id WHERE guix_revision_id = $2 AND guix_revision_system_test_derivations.system = $3 ) SELECT base_system_tests.name, base_system_tests.description, base_system_tests.derivation_file_name, base_system_tests.file, base_system_tests.line, base_system_tests.column_number, ( SELECT JSON_AGG( json_build_object( 'build_server_id', builds.build_server_id, 'build_server_build_id', builds.build_server_build_id, 'status', latest_build_status.status, 'timestamp', latest_build_status.timestamp, 'build_for_equivalent_derivation', builds.derivation_file_name != base_system_tests.derivation_file_name ) ORDER BY latest_build_status.timestamp ) FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = base_system_tests.derivation_output_details_set_id ) AS base_builds, target_system_tests.name, target_system_tests.description, target_system_tests.derivation_file_name, target_system_tests.file, target_system_tests.line, target_system_tests.column_number, ( SELECT JSON_AGG( json_build_object( 'build_server_id', builds.build_server_id, 'build_server_build_id', builds.build_server_build_id, 'status', latest_build_status.status, 'timestamp', latest_build_status.timestamp, 'build_for_equivalent_derivation', builds.derivation_file_name != target_system_tests.derivation_file_name ) ORDER BY latest_build_status.timestamp ) FROM builds INNER JOIN latest_build_status ON builds.id = latest_build_status.build_id WHERE builds.derivation_output_details_set_id = target_system_tests.derivation_output_details_set_id ) AS target_builds FROM base_system_tests FULL OUTER JOIN target_system_tests ON base_system_tests.name = target_system_tests.name WHERE base_system_tests.name IS NULL OR target_system_tests.name IS NULL OR base_system_tests.derivation_file_name != target_system_tests.derivation_file_name ORDER BY coalesce(base_system_tests.name, target_system_tests.name) ASC")) (map (match-lambda ((base_name base_description base_derivation_file_name base_file base_line base_column_number base_builds target_name target_description target_derivation_file_name target_file target_line target_column_number target_builds) (define (location->alist file line column-number) `((file . ,file) (line . ,(string->number line)) (column_number . ,(string->number column-number)))) `((name . ,(or base_name target_name)) (description . ,(if (and (string? base_description) (string? target_description) (string=? base_description target_description)) base_description `((base . ,(if (null? base_description) 'null base_description)) (target . ,(if (null? target_description) 'null target_description))))) (derivation . ,(if (and (string? base_derivation_file_name) (string? target_derivation_file_name) (string=? base_derivation_file_name target_derivation_file_name)) base_derivation_file_name `((base . ,(if (null? base_derivation_file_name) 'null base_derivation_file_name)) (target . ,(if (null? target_derivation_file_name) 'null target_derivation_file_name))))) (location . ,(if (and (string? base_file) (string? target_file) (string=? base_file target_file) (string=? base_line target_line) (string=? base_column_number target_column_number)) (location->alist base_file base_line base_column_number) `((base . ,(if (null? base_file) 'null (location->alist base_file base_line base_column_number))) (target . ,(if (null? target_file) 'null (location->alist target_file target_line target_column_number)))))) (builds . ,(if (and (string? base_derivation_file_name) (string? target_derivation_file_name) (string=? base_derivation_file_name target_derivation_file_name)) (json-string->scm base_builds) `((base . ,(if (null? base_builds) #() (json-string->scm base_builds))) (target . ,(if (null? target_builds) #() (json-string->scm target_builds))))))))) (exec-query-with-null-handling conn query (list base_guix_revision_id target_guix_revision_id system)))) (define (channel-news-differences-data conn base-guix-revision-id target-guix-revision-id) (define query " WITH base_news_entries AS ( SELECT channel_news_entries.id, channel_news_entries.commit, channel_news_entries.tag, ( SELECT JSON_AGG(ARRAY[lang,text]) FROM channel_news_entry_text INNER JOIN channel_news_entry_titles ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id ) AS title_text, ( SELECT JSON_AGG(ARRAY[lang,text]) FROM channel_news_entry_text INNER JOIN channel_news_entry_bodies ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id ) AS body_text FROM channel_news_entries WHERE id IN ( SELECT channel_news_entry_id FROM guix_revision_channel_news_entries WHERE guix_revision_channel_news_entries.guix_revision_id = $1 ) ), target_news_entries AS ( SELECT channel_news_entries.id, channel_news_entries.commit, channel_news_entries.tag, ( SELECT JSON_AGG(ARRAY[lang,text]) FROM channel_news_entry_text INNER JOIN channel_news_entry_titles ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id ) AS title_text, ( SELECT JSON_AGG(ARRAY[lang,text]) FROM channel_news_entry_text INNER JOIN channel_news_entry_bodies ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id ) AS body_text FROM channel_news_entries WHERE id IN ( SELECT channel_news_entry_id FROM guix_revision_channel_news_entries WHERE guix_revision_channel_news_entries.guix_revision_id = $2 ) ) SELECT coalesce( base_news_entries.commit, target_news_entries.commit ) AS commit, coalesce( base_news_entries.tag, target_news_entries.tag ) AS tag, coalesce( base_news_entries.title_text, target_news_entries.title_text ) AS title_text, coalesce( base_news_entries.body_text, target_news_entries.body_text ) AS body_text, CASE WHEN base_news_entries.id IS NULL THEN 'new' WHEN target_news_entries.id IS NULL THEN 'removed' ELSE 'changed' END AS change FROM base_news_entries FULL OUTER JOIN target_news_entries ON base_news_entries.commit = target_news_entries.commit WHERE ( base_news_entries.id IS NULL OR target_news_entries.id IS NULL OR base_news_entries.id != target_news_entries.id )") (map (match-lambda ((commit tag title_text body_text change) (list commit tag (map (match-lambda (#(lang text) (cons lang text))) (vector->list (json-string->scm title_text))) (map (match-lambda (#(lang text) (cons lang text))) (vector->list (json-string->scm body_text))) (string->symbol change)))) (exec-query-with-null-handling conn query (list base-guix-revision-id target-guix-revision-id))))