Rework cross derivations support

Stop using the system values as targets, and remove package derivation entries
where this is the case.

Switch the non-cross derivation case to have a target of "", rather than
matching the system, as this makes more sense, and is more consistent now that
the target values no longer match the system values.

Hardcode some more correct target values, and use these instead. Hopefully
this can be better integrated with Guix in the future.

This commit also includes a migration attempting to shrink some indexes.

guix-data-service/jobs/load-new-guix-revision.scm

@@ -384,21 +384,37 @@ WHERE job_id = $1"
   (define inferior-%supported-systems
     (inferior-eval '(@ (guix packages) %supported-systems) inf))
 
+  (define cross-derivations
+    `(("x86_64-linux" . ("arm-linux-gnueabihf"
+                         "aarch64-linux-gnu"
+                         "powerpc-linux-gnu"
+                         "riscv64-linux-gnu"
+                         "i586-pc-gnu"))))
+
   (define supported-system-pairs
     (map (lambda (system)
-           (cons system system))
+           (cons system #f))
          inferior-%supported-systems))
 
   (define supported-system-cross-build-pairs
-    (map (lambda (system)
+    (append-map
-           (filter-map (lambda (target)
+     (match-lambda
-                         (and (not (string=? system target))
+       ((system . targets)
-                              (cons system target)))
+        (list
-                       inferior-%supported-systems))
+         (map (lambda (target)
-         inferior-%supported-systems))
+                (cons system target))
+              targets))))
+     cross-derivations))
 
   (define (proc packages system-target-pairs)
     `(lambda (store)
+       (define target-system-alist
+         '(("arm-linux-gnueabihf" . "armhf-linux")
+           ("aarch64-linux-gnu" . "aarch64-linux")
+           ("powerpc-linux-gnu" . "")   ; TODO I don't know?
+           ("riscv64-linux-gnu" . "")   ; TODO I don't know?
+           ("i586-pc-gnu" . "i586-gnu")))
+
        (define package-transitive-supported-systems-supports-multiple-arguments? #t)
 
        (define (get-supported-systems package system)
@@ -441,11 +457,11 @@ WHERE job_id = $1"
                      target
                      (let ((file-name
                             (derivation-file-name
-                             (if (string=? system target)
+                             (if target
-                                 (package-derivation store package system)
                                  (package-cross-derivation store package
                                                            target
-                                                           system)))))
+                                                           system)
+                                 (package-derivation store package system)))))
                        (add-temp-root store file-name)
                        file-name))))
            (lambda args
@@ -470,9 +486,16 @@ WHERE job_id = $1"
                                                                package
                                                                system
                                                                target))
-                          (lset-intersection
+                          (filter
-                           string=?
+                           (match-lambda
-                           supported-systems
+                             (#f #t)  ; No target
+                             (target
+                              (let ((system-for-target
+                                     (assoc-ref target-system-alist
+                                                target)))
+                                (member system-for-target
+                                        supported-systems
+                                        string=?))))
                            (list ,@(map cdr system-target-pairs))))
                          '())))
                  (delete-duplicates
@@ -639,7 +662,7 @@ WHERE job_id = $1"
              (list (inferior-package-id->package-database-id
                     inferior-package-id)
                    system
-                   target)))
+                   (or target ""))))
           inferior-data-4-tuples)))
 
 

guix-data-service/model/derivation.scm

@@ -34,6 +34,7 @@
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service model utils)
   #:export (valid-systems
+            valid-targets
             count-derivations
             select-derivation-by-file-name
             select-derivation-by-file-name-hash
@@ -66,6 +67,14 @@
     "mips64el-linux"
     "x86_64-linux"))
 
+(define (valid-targets conn)
+  '("" ;; no target
+    "arm-linux-gnueabihf"
+    "aarch64-linux-gnu"
+    "powerpc-linux-gnu"
+    "riscv64-linux-gnu"
+    "i586-pc-gnu"))
+
 (define (count-derivations conn)
   (first
    (exec-query

guix-data-service/web/repository/controller.scm

@@ -257,7 +257,7 @@
           `((system  ,(parse-build-system conn)
                      #:default "x86_64-linux")
             (target  ,(parse-build-system conn)
-                     #:default "x86_64-linux")))))
+                     #:default "")))))
     (let* ((system
             (assq-ref parsed-query-parameters 'system))
            (target
@@ -304,5 +304,6 @@
                   branch-name
                   package-name
                   (valid-systems conn)
+                  (valid-targets conn)
                   build-server-urls
                   package-derivations)))))))

guix-data-service/web/repository/html.scm

@@ -327,6 +327,7 @@
                                          branch-name
                                          package-name
                                          valid-systems
+                                         valid-targets
                                          build-server-urls
                                          derivations-by-revision-range)
   (define versions-list
@@ -383,7 +384,7 @@
            #:help-text "Show derivations with this system.")
          ,(form-horizontal-control
            "Target" query-parameters
-           #:options valid-systems
+           #:options valid-targets
            #:allow-selecting-multiple-options #f
            #:help-text "Show derivations with this target.")
          (div (@ (class "form-group form-group-lg"))

guix-data-service/web/revision/controller.scm

@@ -172,7 +172,7 @@
                   request
                   `((search_query   ,identity)
                     (system ,parse-system #:multi-value)
-                    (target ,parse-system #:multi-value)
+                    (target ,identity #:multi-value)
                     (maximum_builds ,parse-number)
                     (minimum_builds ,parse-number)
                     (after_name ,identity)
@@ -201,7 +201,7 @@
                     (output_consistency ,identity
                                         #:default "any")
                     (system ,parse-system #:default "x86_64-linux")
-                    (target ,parse-system #:default "x86_64-linux")
+                    (target ,identity)
                     (limit_results  ,parse-result-limit
                                     #:no-default-when (all_results)
                                     #:default 10)
@@ -242,7 +242,7 @@
                  `((build_status ,parse-build-status #:multi-value)
                    (build_server ,(parse-build-server conn) #:multi-value)
                    (system ,parse-system #:default "x86_64-linux")
-                   (target ,parse-system #:default "x86_64-linux")))))
+                   (target ,identity)))))
 
            (render-revision-builds mime-types
                                    conn
@@ -661,6 +661,7 @@
           #:sxml (view-revision-derivations commit-hash
                                             query-parameters
                                             (valid-systems conn)
+                                            (valid-targets conn)
                                             '()
                                             '()
                                             #f
@@ -717,6 +718,7 @@
             #:sxml (view-revision-derivations commit-hash
                                               query-parameters
                                               (valid-systems conn)
+                                              (valid-targets conn)
                                               derivations
                                               build-server-urls
                                               show-next-page?
@@ -748,6 +750,7 @@
                                                    '()
                                                    '()
                                                    '()
+                                                   '()
                                                    #:path-base path-base
                                                    #:header-text header-text
                                                    #:header-link header-link))))
@@ -790,6 +793,7 @@
                                                      derivation-outputs
                                                      build-server-urls
                                                      (valid-systems conn)
+                                                     (valid-targets conn)
                                                      show-next-page?
                                                      #:path-base path-base
                                                      #:header-text header-text

guix-data-service/web/revision/html.scm

@@ -967,6 +967,7 @@ figure {
 (define* (view-revision-derivations commit-hash
                                     query-parameters
                                     valid-systems
+                                    valid-targets
                                     derivations
                                     build-server-urls
                                     show-next-page?
@@ -1007,7 +1008,7 @@ figure {
             #:font-family "monospace")
           ,(form-horizontal-control
             "Target" query-parameters
-            #:options valid-systems
+            #:options valid-targets
             #:help-text "Only include derivations that are build for this system."
             #:font-family "monospace")
           ,(form-horizontal-control
@@ -1096,6 +1097,7 @@ figure {
                                            derivation-outputs
                                            build-server-urls
                                            valid-systems
+                                           valid-targets
                                            show-next-page?
                                            #:key (path-base "/revision/")
                                            header-text
@@ -1144,7 +1146,7 @@ figure {
             #:font-family "monospace")
           ,(form-horizontal-control
             "Target" query-parameters
-            #:options valid-systems
+            #:options valid-targets
             #:allow-selecting-multiple-options #f
             #:help-text "Only include outputs from derivations that are build for this system."
             #:font-family "monospace")

sqitch/deploy/change_package_derivations_by_guix_revision_range_target.sql

@@ -0,0 +1,15 @@
+-- Deploy guix-data-service:change_package_derivations_by_guix_revision_range_target to pg
+
+BEGIN;
+
+UPDATE package_derivations_by_guix_revision_range SET target = '' WHERE system = target;
+
+DELETE FROM package_derivations_by_guix_revision_range WHERE target IN (
+  'aarch64-linux',
+  'armhf-linux',
+  'i686-linux',
+  'mips64el-linux',
+  'x86_64-linux'
+);
+
+COMMIT;

sqitch/deploy/change_package_derivations_target.sql

@@ -0,0 +1,7 @@
+-- Deploy guix-data-service:change_package_derivations_target to pg
+
+BEGIN;
+
+UPDATE package_derivations SET target = '' WHERE system = target;
+
+COMMIT;

sqitch/deploy/increase_fillfactor_for_some_indexes.sql

@@ -0,0 +1,29 @@
+-- Deploy guix-data-service:increase_fillfactor_for_some_indexes to pg
+
+BEGIN;
+
+ALTER INDEX derivation_inputs_pkey SET (fillfactor = 100);
+ALTER INDEX derivation_inputs_derivation_output_id_idx SET (fillfactor = 100);
+ALTER INDEX guix_revision_package_derivations_pkey SET (fillfactor = 100);
+ALTER INDEX derivations_pkey SET (fillfactor = 100);
+ALTER INDEX file_name_unique SET (fillfactor = 100);
+ALTER INDEX id_unique SET (fillfactor = 100);
+ALTER INDEX derivations_hash SET (fillfactor = 100);
+ALTER INDEX package_derivations_pkey SET (fillfactor = 100);
+ALTER INDEX package_derivations_id_key SET (fillfactor = 100);
+ALTER INDEX package_derivations_derivation_id SET (fillfactor = 100);
+ALTER INDEX package_derivations_package_id_idx SET (fillfactor = 100);
+
+REINDEX INDEX derivation_inputs_pkey;
+REINDEX INDEX derivation_inputs_derivation_output_id_idx;
+REINDEX INDEX guix_revision_package_derivations_pkey;
+REINDEX INDEX derivations_pkey;
+REINDEX INDEX file_name_unique;
+REINDEX INDEX id_unique;
+REINDEX INDEX derivations_hash;
+REINDEX INDEX package_derivations_pkey;
+REINDEX INDEX package_derivations_id_key;
+REINDEX INDEX package_derivations_derivation_id;
+REINDEX INDEX package_derivations_package_id_idx;
+
+COMMIT;

sqitch/deploy/remove_old_cross_derivations.sql

@@ -0,0 +1,30 @@
+-- Deploy guix-data-service:remove_old_cross_derivations to pg
+
+BEGIN;
+
+DELETE FROM guix_revision_package_derivations WHERE package_derivation_id IN (
+  SELECT id
+  FROM package_derivations
+  WHERE target IN (
+    'aarch64-linux',
+    'armhf-linux',
+    'i686-linux',
+    'mips64el-linux',
+    'x86_64-linux'
+  )
+);
+
+-- Checking this constraint is expensive, so drop it, then re-create it
+ALTER TABLE guix_revision_package_derivations DROP CONSTRAINT guix_revision_package_derivations_package_derivation_id_fkey;
+
+DELETE FROM package_derivations WHERE target IN (
+  'aarch64-linux',
+  'armhf-linux',
+  'i686-linux',
+  'mips64el-linux',
+  'x86_64-linux'
+);
+
+ALTER TABLE guix_revision_package_derivations ADD CONSTRAINT "guix_revision_package_derivations_package_derivation_id_fkey" FOREIGN KEY (package_derivation_id) REFERENCES package_derivations(id);
+
+COMMIT;

sqitch/revert/change_package_derivations_by_guix_revision_range_target.sql

@@ -0,0 +1,7 @@
+-- Revert guix-data-service:change_package_derivations_by_guix_revision_range_target from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;

sqitch/revert/change_package_derivations_target.sql

@@ -0,0 +1,7 @@
+-- Revert guix-data-service:change_package_derivations_target from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;

sqitch/revert/increase_fillfactor_for_some_indexes.sql

@@ -0,0 +1,7 @@
+-- Revert guix-data-service:increase_fillfactor_for_some_indexes from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;

sqitch/revert/remove_old_cross_derivations.sql

@@ -0,0 +1,7 @@
+-- Revert guix-data-service:remove_old_cross_derivations from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;

sqitch/sqitch.plan

@@ -44,3 +44,7 @@ derivation_source_files_store_path_hash_index 2019-12-29T17:53:08Z Christopher B
 build_servers_build_config 2020-01-05T12:06:13Z Christopher Baines <mail@cbaines.net> # Add build_servers_build_config table
 git-repositories-x-git-repo-header 2020-01-11T16:39:32Z Christopher Baines <mail@cbaines.net> # Add x_git_repo_header to git_repositories
 system_test_tables 2020-02-02T11:36:20Z Christopher Baines <mail@cbaines.net> # Add tables for storing system tests
+change_package_derivations_target 2020-02-07T19:29:50Z Christopher Baines <mail@cbaines.net> # Change package_derivations target
+remove_old_cross_derivations 2020-02-07T19:42:54Z Christopher Baines <mail@cbaines.net> # Remove old cross derivations
+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

sqitch/verify/change_package_derivations_by_guix_revision_range_target.sql

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

sqitch/verify/change_package_derivations_target.sql

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

sqitch/verify/increase_fillfactor_for_some_indexes.sql

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

sqitch/verify/remove_old_cross_derivations.sql

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