diff options
| -rw-r--r-- | guix-data-service/data-deletion.scm | 42 | ||||
| -rw-r--r-- | guix-data-service/model/build.scm | 10 | ||||
| -rw-r--r-- | guix-data-service/poll-git-repository.scm | 12 | ||||
| -rw-r--r-- | guix-data-service/web/repository/controller.scm | 3 | ||||
| -rw-r--r-- | guix-data-service/web/revision/controller.scm | 13 |
5 files changed, 57 insertions, 23 deletions
diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index c9dc631..3b6dbd0 100644 --- a/guix-data-service/data-deletion.scm +++ b/guix-data-service/data-deletion.scm @@ -255,10 +255,11 @@ WHERE git_repository_id = $1 (list (number->string git-repository-id) branch-name)))) - (delete-revisions-from-branch conn - git-repository-id - branch-name - commits) + (unless (null? commits) + (delete-revisions-from-branch conn + git-repository-id + branch-name + commits)) (exec-query conn @@ -434,10 +435,9 @@ DELETE FROM derivation_source_files WHERE id IN ( SELECT id FROM derivation_source_files - WHERE NOT EXISTS ( - SELECT 1 + WHERE id NOT IN ( + SELECT derivation_source_file_id FROM derivation_sources - WHERE derivation_source_file_id = derivation_source_files.id ) LIMIT 100 ) @@ -551,6 +551,7 @@ DELETE FROM derivations WHERE id = $1" 1))) (define deleted-count 0) + (define ignored-derivation-ids (make-hash-table)) (define channel (make-channel)) (define (delete-batch conn) @@ -588,7 +589,8 @@ WHERE NOT EXISTS ( (set! deleted-count 0) (for-each (lambda (derivation-id) - (put-message channel derivation-id)) + (unless (hash-ref ignored-derivation-ids derivation-id) + (put-message channel derivation-id))) derivations)) (simple-format (current-error-port) @@ -635,6 +637,11 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") 0)))) + (when (= 0 val) + (hash-set! ignored-derivation-ids + derivation-id + #t)) + ;; This is safe as all fibers are in the same ;; thread and cooperative. (set! deleted-count @@ -653,13 +660,18 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") (let ((batch-deleted-count (delete-batch conn))) (if (eq? 0 batch-deleted-count) (begin - (with-time-logging - "Deleting unused derivation_source_files entries" - (delete-unreferenced-derivations-source-files conn)) - (simple-format - (current-output-port) - "Finished deleting derivations, deleted ~A in total\n" - total-deleted)) + (hash-clear! ignored-derivation-ids) + (let ((batch-deleted-count (delete-batch conn))) + (if (= 0 batch-deleted-count) + (begin + (with-time-logging + "Deleting unused derivation_source_files entries" + (delete-unreferenced-derivations-source-files conn)) + (simple-format + (current-output-port) + "Finished deleting derivations, deleted ~A in total\n" + total-deleted)) + (loop (+ total-deleted batch-deleted-count))))) (loop (+ total-deleted batch-deleted-count)))))))) #:hz 0 #:parallelism 1)) diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm index 1240453..86eac9d 100644 --- a/guix-data-service/model/build.scm +++ b/guix-data-service/model/build.scm @@ -136,12 +136,14 @@ WHERE builds.id = $1" (exec-query conn " +WITH derivation_output_details_ids (id) AS ( + SELECT unnest(derivation_output_details_ids) AS id + FROM derivation_output_details_sets + WHERE derivation_output_details_sets.id = $1 +) SELECT derivation_output_details.path FROM derivation_output_details -INNER JOIN derivation_output_details_sets - ON ARRAY[derivation_output_details.id] && - derivation_output_details_sets.derivation_output_details_ids -WHERE derivation_output_details_sets.id = $1" +WHERE derivation_output_details.id IN (SELECT id FROM derivation_output_details_ids)" (list output-details-set-id)) (exec-query conn diff --git a/guix-data-service/poll-git-repository.scm b/guix-data-service/poll-git-repository.scm index 2ed5644..8dfd13d 100644 --- a/guix-data-service/poll-git-repository.scm +++ b/guix-data-service/poll-git-repository.scm @@ -99,6 +99,9 @@ conn 'latest-channel-instances (lambda () + (simple-format (current-error-port) + "polling git repository ~A\n" + git-repository-id) ;; This was using update-cached-checkout, but it wants to checkout ;; refs/remotes/origin/HEAD by default, and that can fail for some reason ;; on some repositories: @@ -158,6 +161,15 @@ oid->string))))) (branch-list repository BRANCH-REMOTE))))) + (simple-format (current-error-port) + "git repository ~A: excluded branches: ~A\n" + git-repository-id + excluded-branches) + (simple-format (current-error-port) + "git repository ~A: included branches: ~A\n" + git-repository-id + included-branches) + (with-postgresql-transaction conn (lambda (conn) diff --git a/guix-data-service/web/repository/controller.scm b/guix-data-service/web/repository/controller.scm index b77ca1f..0d9434c 100644 --- a/guix-data-service/web/repository/controller.scm +++ b/guix-data-service/web/repository/controller.scm @@ -267,7 +267,8 @@ #:path-base path #:header-text `("Latest processed revision for branch " - (samp ,branch-name))) + (samp ,branch-name)) + #:max-age 60) (render-no-latest-revision mime-types repository-id branch-name)))) diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 114e9f4..aa7f226 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -446,7 +446,8 @@ commit-hash #:key path-base (header-text - `("Revision " (samp ,commit-hash)))) + `("Revision " (samp ,commit-hash))) + (max-age cache-control-default-max-age)) (letpar& ((packages-count (with-resource-from-pool (connection-pool) conn (count-packages-in-revision conn commit-hash))) @@ -484,7 +485,10 @@ (network_dependent . ,(string=? network-dependent "t")) (count . ,(string->number count)))))) lint-warning-counts))) - #:extra-headers http-headers-for-unchanging-content)) + #:extra-headers + `((cache-control + . (public + (max-age . ,max-age)))))) (else (render-html #:sxml (view-revision @@ -496,7 +500,10 @@ lint-warning-counts #:path-base path-base #:header-text header-text) - #:extra-headers http-headers-for-unchanging-content))))) + #:extra-headers + `((cache-control + . (public + (max-age . ,max-age))))))))) (define* (render-revision-system-tests mime-types commit-hash |