diff options
Diffstat (limited to 'guix-build-coordinator/datastore/sqlite.scm')
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 159 |
1 files changed, 121 insertions, 38 deletions
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index be5dc98..211f09d 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -281,45 +281,16 @@ PRAGMA optimize;"))))) (define registry (slot-ref datastore 'metrics-registry)) - (let ((builds-total - (make-gauge-metric registry - "builds_total" - #:labels '(system))) - (build-results-total - (make-gauge-metric registry - "build_results_total" - #:labels '(agent_id result))) - (setup-failures-total + (let ((setup-failures-total (make-gauge-metric registry "setup_failures_total" #:labels '(agent_id reason)))) - (letpar& ((build-counts - (with-time-logging "counting builds" - (datastore-count-builds datastore))) - (build-result-counts - (with-time-logging "counting build results" - (datastore-count-build-results datastore))) - (setup-failure-counts + (letpar& ((setup-failure-counts (with-time-logging "counting setup failures" (datastore-count-setup-failures datastore)))) (for-each (match-lambda - ((system . count) - (metric-set builds-total - count - #:label-values - `((system . ,system))))) - build-counts) - (for-each (match-lambda - (((agent-id result) . count) - (metric-set build-results-total - count - #:label-values - `((agent_id . ,agent-id) - (result . ,result))))) - build-result-counts) - (for-each (match-lambda (((agent-id reason) . count) (metric-set setup-failures-total count @@ -338,6 +309,16 @@ PRAGMA optimize;"))))) (registry (slot-ref datastore 'metrics-registry)) + (builds-total + (or (metrics-registry-fetch-metric registry "builds_total") + (make-gauge-metric registry + "builds_total" + #:labels '(system)))) + (build-results-total + (or (metrics-registry-fetch-metric registry "build_results_total") + (make-gauge-metric registry + "build_results_total" + #:labels '(agent_id result)))) (db-bytes (or (metrics-registry-fetch-metric registry "datastore_bytes") @@ -351,6 +332,26 @@ PRAGMA optimize;"))))) registry "datastore_wal_bytes" #:docstring "Size of the SQLite Write Ahead Log file")))) + (letpar& ((build-counts + (datastore-count-builds datastore)) + (build-result-counts + (datastore-count-build-results datastore))) + (for-each (match-lambda + ((system . count) + (metric-set builds-total + count + #:label-values + `((system . ,system))))) + build-counts) + (for-each (match-lambda + (((agent-id result) . count) + (metric-set build-results-total + count + #:label-values + `((agent_id . ,agent-id) + (result . ,result))))) + build-result-counts)) + (metric-set db-bytes (stat:size (stat db-filename))) (metric-set db-wal-bytes (stat:size (stat db-wal-filename)))) #t) @@ -1575,7 +1576,7 @@ DELETE FROM build_allocation_plan WHERE build_id = :build_id" (sqlite-prepare db " -SELECT agent_id, result, COUNT(*) FROM build_results GROUP BY agent_id, result" +SELECT agent_id, result, count FROM build_results_counts" #:cache? #t))) (let ((result @@ -1591,6 +1592,45 @@ SELECT agent_id, result, COUNT(*) FROM build_results GROUP BY agent_id, result" (define-method (datastore-insert-build-result (datastore <sqlite-datastore>) build-uuid agent-id result failure-reason) + (define (increment-count db) + (let ((statement + (sqlite-prepare + db + " +UPDATE build_results_counts +SET count = count + 1 +WHERE agent_id = :agent_id + AND result = :result +RETURNING count" + #:cache? #t)) + (insert-statement + (sqlite-prepare + db + " +INSERT INTO build_results_counts (agent_id, result, count) +VALUES (:agent_id, :result, 1)" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:agent_id agent-id + #:result result) + + (match (let ((res (sqlite-step statement))) + (sqlite-reset statement) + res) + (#(count) #t) + (#f + (sqlite-bind-arguments + insert-statement + #:agent_id agent-id + #:result result) + + (sqlite-step insert-statement) + (sqlite-reset insert-statement) + + #t)))) + (call-with-worker-thread/delay-logging (slot-ref datastore 'worker-writer-thread-channel) (lambda (db) @@ -1607,7 +1647,9 @@ INSERT INTO build_results ( (if failure-reason (string-append "'" failure-reason "'") "NULL") - ")")))) + ")")) + + (increment-count db))) #t) (define-method (datastore-update-unprocessed-builds-for-build-success @@ -2017,11 +2059,8 @@ WHERE setup_failure_id = :id" (sqlite-prepare db " -SELECT derivations.system_id, COUNT(*) -FROM builds -INNER JOIN derivations - ON builds.derivation_id = derivations.id -GROUP BY derivations.system_id" +SELECT system_id, count +FROM builds_counts" #:cache? #t))) (let ((result @@ -4215,6 +4254,41 @@ RETURNING id" id)))) + (define (increment-builds-counts db system-id) + (let ((statement + (sqlite-prepare + db + " +UPDATE builds_counts +SET count = count + 1 +WHERE system_id = :system_id +RETURNING count" + #:cache? #t)) + (insert-statement + (sqlite-prepare + db + " +INSERT INTO builds_counts (system_id, count) VALUES (:system_id, 1)" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:system_id system-id) + + (match (let ((res (sqlite-step statement))) + (sqlite-reset statement) + res) + (#(count) #t) + (#f + (sqlite-bind-arguments + insert-statement + #:system_id system-id) + + (sqlite-step insert-statement) + (sqlite-reset insert-statement) + + #t)))) + (define (all-inputs-built? db build-id) (let ((statement (sqlite-prepare @@ -4268,6 +4342,13 @@ VALUES (:build_id, :derived_priority, :all_inputs_built)" (apply (lambda* (uuid drv-name priority defer-until #:key skip-updating-other-build-derived-priorities) + (define system-id + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (db-system->system-id + db + (datastore-find-derivation-system datastore drv-name))))) (call-with-worker-thread/delay-logging (slot-ref datastore 'worker-writer-thread-channel) @@ -4281,6 +4362,8 @@ VALUES (:build_id, :derived_priority, :all_inputs_built)" priority)) (all-inputs-built? (all-inputs-built? db build-id))) + (increment-builds-counts db system-id) + (insert-unprocessed-builds-with-derived-priorities-entry db build-id |