263 lines
9.5 KiB
Scheme
263 lines
9.5 KiB
Scheme
;;; Guix Data Service -- Information about Guix over time
|
|
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
|
|
;;;
|
|
;;; 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
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (guix-data-service model package-derivation-by-guix-revision-range)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (squee)
|
|
#:use-module (guix-data-service database)
|
|
#:use-module (guix-data-service model git-branch)
|
|
#:use-module (guix-data-service utils)
|
|
#:export (insert-guix-revision-package-derivation-entries
|
|
update-package-derivations-table
|
|
vacuum-package-derivations-table
|
|
rebuild-package-derivations-table))
|
|
|
|
(define (delete-guix-revision-package-derivation-entries conn
|
|
git-repository-id
|
|
guix-revision-id
|
|
branch-name)
|
|
(and=>
|
|
(git-branch-for-repository-and-name conn
|
|
(string->number git-repository-id)
|
|
branch-name)
|
|
(lambda (git-branch-id)
|
|
(exec-query
|
|
conn
|
|
"
|
|
DELETE FROM package_derivations_by_guix_revision_range
|
|
WHERE git_branch_id = $1 AND
|
|
derivation_id IN (
|
|
SELECT package_derivations.derivation_id
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = $2
|
|
)"
|
|
(list (number->string git-branch-id)
|
|
guix-revision-id)))))
|
|
|
|
(define (insert-guix-revision-package-derivation-entries conn
|
|
git-repository-id
|
|
branch-name)
|
|
(define query
|
|
"
|
|
INSERT INTO package_derivations_by_guix_revision_range
|
|
SELECT DISTINCT
|
|
$2,
|
|
packages.name AS package_name,
|
|
packages.version AS package_version,
|
|
revision_packages.derivation_id AS derivation_id,
|
|
revision_packages.system AS system,
|
|
revision_packages.target AS target,
|
|
first_value(guix_revisions.id)
|
|
OVER package_version AS first_guix_revision_id,
|
|
last_value(guix_revisions.id)
|
|
OVER package_version AS last_guix_revision_id
|
|
FROM packages
|
|
INNER JOIN (
|
|
SELECT package_derivations.package_id,
|
|
package_derivations.derivation_id,
|
|
systems.system,
|
|
package_derivations.target,
|
|
guix_revision_package_derivations.revision_id
|
|
FROM package_derivations
|
|
INNER JOIN systems
|
|
ON package_derivations.system_id = systems.id
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
|
|
) AS revision_packages ON packages.id = revision_packages.package_id
|
|
INNER JOIN guix_revisions
|
|
ON guix_revisions.git_repository_id = $1
|
|
AND revision_packages.revision_id = guix_revisions.id
|
|
INNER JOIN git_branches
|
|
ON git_branches.id = $2
|
|
INNER JOIN git_commits
|
|
ON git_branches.id = git_commits.git_branch_id
|
|
AND guix_revisions.commit = git_commits.commit
|
|
WINDOW package_version AS (
|
|
PARTITION BY git_branches.git_repository_id, git_branches.name,
|
|
packages.name, packages.version, revision_packages.derivation_id
|
|
ORDER BY git_commits.datetime
|
|
RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING
|
|
)
|
|
ORDER BY packages.name, packages.version")
|
|
|
|
(let ((git-branch-id (git-branch-for-repository-and-name conn
|
|
(string->number
|
|
git-repository-id)
|
|
branch-name)))
|
|
(exec-query
|
|
conn
|
|
(string-append
|
|
"
|
|
CREATE TABLE IF NOT EXISTS package_derivations_by_guix_revision_range_git_branch_"
|
|
(number->string git-branch-id) "
|
|
PARTITION OF package_derivations_by_guix_revision_range FOR VALUES IN ("
|
|
(number->string git-branch-id)
|
|
")"))
|
|
|
|
(exec-query
|
|
conn
|
|
query
|
|
(list git-repository-id
|
|
(number->string git-branch-id)))))
|
|
|
|
(define (insert-guix-revision-package-derivation-entries-for-guix-revision
|
|
conn
|
|
git-repository-id
|
|
branch-name
|
|
guix-revision-id)
|
|
|
|
(define query
|
|
"
|
|
INSERT INTO package_derivations_by_guix_revision_range
|
|
SELECT DISTINCT
|
|
git_branches.id,
|
|
packages.name AS package_name,
|
|
packages.version AS package_version,
|
|
revision_packages.derivation_id AS derivation_id,
|
|
revision_packages.system AS system,
|
|
revision_packages.target AS target,
|
|
first_value(guix_revisions.id)
|
|
OVER package_version AS first_guix_revision_id,
|
|
last_value(guix_revisions.id)
|
|
OVER package_version AS last_guix_revision_id
|
|
FROM packages
|
|
INNER JOIN (
|
|
SELECT package_derivations.package_id,
|
|
package_derivations.derivation_id,
|
|
systems.system,
|
|
package_derivations.target,
|
|
guix_revision_package_derivations.revision_id
|
|
FROM package_derivations
|
|
INNER JOIN systems
|
|
ON package_derivations.system_id = systems.id
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
|
|
) AS revision_packages ON packages.id = revision_packages.package_id
|
|
INNER JOIN guix_revisions
|
|
ON guix_revisions.git_repository_id = $1
|
|
AND revision_packages.revision_id = guix_revisions.id
|
|
INNER JOIN git_branches
|
|
ON git_branches.name = $2
|
|
AND git_branches.git_repository_id = $1
|
|
INNER JOIN git_commits
|
|
ON git_branches.id = git_commits.git_branch_id
|
|
AND guix_revisions.commit = git_commits.commit
|
|
WHERE revision_packages.derivation_id IN (
|
|
SELECT package_derivations.derivation_id
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = $3
|
|
)
|
|
WINDOW package_version AS (
|
|
PARTITION BY git_branches.git_repository_id, git_branches.name,
|
|
packages.name, packages.version, revision_packages.derivation_id
|
|
ORDER BY git_commits.datetime
|
|
RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING
|
|
)
|
|
ORDER BY packages.name, packages.version")
|
|
|
|
(exec-query
|
|
conn
|
|
query
|
|
(list git-repository-id
|
|
branch-name
|
|
guix-revision-id)))
|
|
|
|
(define (update-package-derivations-table conn
|
|
git-repository-id
|
|
guix-revision-id
|
|
commit)
|
|
;; Lock the table to wait for other transactions to commit before updating
|
|
;; the table
|
|
(exec-query
|
|
conn
|
|
"
|
|
LOCK TABLE ONLY package_derivations_by_guix_revision_range
|
|
IN SHARE ROW EXCLUSIVE MODE")
|
|
|
|
(for-each
|
|
(match-lambda
|
|
((branch-name)
|
|
(with-time-logging
|
|
(simple-format #f "deleting package derivation entries for ~A"
|
|
branch-name)
|
|
(delete-guix-revision-package-derivation-entries conn
|
|
git-repository-id
|
|
guix-revision-id
|
|
branch-name))
|
|
(with-time-logging
|
|
(simple-format #f "inserting package derivation entries for ~A"
|
|
branch-name)
|
|
(insert-guix-revision-package-derivation-entries-for-guix-revision
|
|
conn
|
|
git-repository-id
|
|
branch-name
|
|
guix-revision-id))))
|
|
(exec-query
|
|
conn
|
|
"
|
|
SELECT name
|
|
FROM git_branches
|
|
INNER JOIN git_commits
|
|
ON git_branches.id = git_commits.git_branch_id
|
|
AND git_commits.commit = $1
|
|
WHERE git_repository_id = $2
|
|
"
|
|
(list commit git-repository-id)))
|
|
|
|
#t)
|
|
|
|
(define (vacuum-package-derivations-table conn)
|
|
(exec-query
|
|
conn
|
|
"VACUUM package_derivations_by_guix_revision_range"))
|
|
|
|
(define (rebuild-package-derivations-table conn)
|
|
(with-postgresql-transaction
|
|
conn
|
|
(lambda (conn)
|
|
;; Lock the table to wait for other transactions to commit before updating
|
|
;; the table
|
|
(exec-query
|
|
conn
|
|
"
|
|
LOCK TABLE ONLY package_derivations_by_guix_revision_range
|
|
IN SHARE ROW EXCLUSIVE MODE")
|
|
|
|
(with-time-logging
|
|
(simple-format #f "deleting all package derivation entries")
|
|
(exec-query conn "DELETE FROM package_derivations_by_guix_revision_range"))
|
|
|
|
(let ((git-branches-and-repository-ids
|
|
(exec-query
|
|
conn
|
|
"SELECT DISTINCT name, git_repository_id FROM git_branches")))
|
|
(for-each
|
|
(match-lambda
|
|
((branch-name git-repository-id)
|
|
(with-time-logging
|
|
(simple-format #f "inserting package derivation entries for ~A"
|
|
branch-name)
|
|
(insert-guix-revision-package-derivation-entries
|
|
conn
|
|
git-repository-id
|
|
branch-name))))
|
|
git-branches-and-repository-ids)))))
|