Start storing channel instance derivations

These are the ones that relate to Guix pull.
This commit is contained in:
Christopher Baines 2020-02-11 08:56:24 +00:00
parent 406aa5e160
commit 9be7dbac0b
8 changed files with 110 additions and 11 deletions

View file

@ -76,6 +76,7 @@ SOURCES = \
guix-data-service/model/build-server-token-seed.scm \ guix-data-service/model/build-server-token-seed.scm \
guix-data-service/model/build-status.scm \ guix-data-service/model/build-status.scm \
guix-data-service/model/build.scm \ guix-data-service/model/build.scm \
guix-data-service/model/channel-instance.scm \
guix-data-service/model/channel-news.scm \ guix-data-service/model/channel-news.scm \
guix-data-service/model/derivation.scm \ guix-data-service/model/derivation.scm \
guix-data-service/model/git-branch.scm \ guix-data-service/model/git-branch.scm \

View file

@ -35,6 +35,7 @@
#:use-module (guix-data-service config) #:use-module (guix-data-service config)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service model build) #:use-module (guix-data-service model build)
#:use-module (guix-data-service model channel-instance)
#:use-module (guix-data-service model channel-news) #:use-module (guix-data-service model channel-news)
#:use-module (guix-data-service model package) #:use-module (guix-data-service model package)
#:use-module (guix-data-service model package-derivation-by-guix-revision-range) #:use-module (guix-data-service model package-derivation-by-guix-revision-range)
@ -1206,6 +1207,17 @@ ORDER BY packages.name, packages.version"
guix-revision-id guix-revision-id
(extract-information-from conn guix-revision-id (extract-information-from conn guix-revision-id
commit store-item) commit store-item)
(insert-channel-instances conn
guix-revision-id
(filter-map
(match-lambda
((system . derivations)
(and=>
(assoc-ref derivations
'manifest-entry-item)
(lambda (drv)
(cons system drv)))))
channel-derivations-by-system))
(if (defined? 'channel-news-for-commit (if (defined? 'channel-news-for-commit
(resolve-module '(guix channels))) (resolve-module '(guix channels)))
(log-time (log-time

View file

@ -0,0 +1,52 @@
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2020 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 channel-instance)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (json)
#:use-module (guix utils)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service model derivation)
#:export (insert-channel-instances))
(define (insert-channel-instances conn
guix-revision-id
derivations-by-system)
(let ((derivation-ids
(derivation-file-names->derivation-ids
conn
(map cdr derivations-by-system))))
(exec-query
conn
(string-append
"
INSERT INTO channel_instances
(guix_revision_id, system, derivation_id)
VALUES "
(string-join
(map (lambda (system derivation-id)
(simple-format #f "(~A, '~A', ~A)"
guix-revision-id
system
derivation-id))
(map car derivations-by-system)
derivation-ids)
", "))))
#t)

View file

@ -0,0 +1,13 @@
-- Deploy guix-data-service:channel_instance_derivations to pg
BEGIN;
CREATE TABLE channel_instances (
guix_revision_id integer NOT NULL REFERENCES guix_revisions(id),
system varchar NOT NULL,
derivation_id integer NOT NULL REFERENCES derivations (id),
PRIMARY KEY (guix_revision_id, system),
UNIQUE (derivation_id)
);
COMMIT;

View file

@ -0,0 +1,7 @@
-- Revert guix-data-service:channel_instance_derivations from pg
BEGIN;
DROP TABLE channel_instances;
COMMIT;

View file

@ -49,3 +49,4 @@ remove_old_cross_derivations 2020-02-07T19:42:54Z Christopher Baines <mail@cbain
increase_fillfactor_for_some_indexes 2020-02-07T20:49:17Z Christopher Baines <mail@cbaines.net> # Increase the fillfactor for some btree indexes increase_fillfactor_for_some_indexes 2020-02-07T20:49:17Z Christopher Baines <mail@cbaines.net> # Increase the fillfactor for some btree indexes
change_package_derivations_by_guix_revision_range_target 2020-02-08T10:13:07Z Christopher Baines <mail@cbaines.net> # Change the values for package_derivations_by_guix_revision_range target change_package_derivations_by_guix_revision_range_target 2020-02-08T10:13:07Z Christopher Baines <mail@cbaines.net> # Change the values for package_derivations_by_guix_revision_range target
allow_including_and_excluding_branches_for_repositories 2020-02-08T11:30:02Z Christopher Baines <mail@cbaines.net> # Allow including and excluding branches for repositories allow_including_and_excluding_branches_for_repositories 2020-02-08T11:30:02Z Christopher Baines <mail@cbaines.net> # Allow including and excluding branches for repositories
channel_instance_derivations 2020-02-10T07:59:03Z Christopher Baines <mail@cbaines.net> # Add tables to store derivations for channel instances

View file

@ -0,0 +1,7 @@
-- Verify guix-data-service:channel_instance_derivations on pg
BEGIN;
-- XXX Add verifications here.
ROLLBACK;

View file

@ -44,18 +44,24 @@
#t)) #t))
(mock (mock
((guix channels) ((guix-data-service model channel-instance)
channel-news-for-commit insert-channel-instances
(lambda (channel commit) (lambda (conn guix-revision-id derivations-by-system)
'())) #t))
(match (enqueue-load-new-guix-revision-job (mock
conn ((guix channels)
(git-repository-url->git-repository-id conn "test-url") channel-news-for-commit
"test-commit" (lambda (channel commit)
"test-source") '()))
((id)
(process-load-new-guix-revision-job id)))))))) (match (enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
((id)
(process-load-new-guix-revision-job id)))))))))
(exec-query conn "TRUNCATE guix_revisions CASCADE") (exec-query conn "TRUNCATE guix_revisions CASCADE")
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE") (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")