From 9f89356c85c85a3f7a90c6219c7e954ef2f4a2a9 Mon Sep 17 00:00:00 2001 From: Thomas Hintz Date: Sat, 25 Jul 2026 11:00:20 -0700 Subject: [PATCH] Don't try to make a backup on inital deployment. --- src/db-init.sql | 2 +- src/db.scm | 6 +- ...xtend-deployment-status-add-ignored-up.sql | 1 + src/nassella.scm | 97 +++++++++++-------- 4 files changed, 60 insertions(+), 46 deletions(-) create mode 100644 src/migrations/9-extend-deployment-status-add-ignored-up.sql diff --git a/src/db-init.sql b/src/db-init.sql index 458f49c..f3f5635 100644 --- a/src/db-init.sql +++ b/src/db-init.sql @@ -93,7 +93,7 @@ create table user_app_configs( create unique index user_app_configs_user_id_instance_id_idx on user_app_configs (user_id, instance_id); -create type deployment_status as enum ('queued', 'in-progress', 'complete', 'failed'); +create type deployment_status as enum ('ignored', 'queued', 'in-progress', 'complete', 'failed'); create table deployments( id bigserial primary key, diff --git a/src/db.scm b/src/db.scm index b94fb2d..d472491 100644 --- a/src/db.scm +++ b/src/db.scm @@ -378,7 +378,8 @@ where usa.user_id=$1 and usa.instance_id=$2;" '((queued . "queued") (in-progress . "in-progress") (complete . "complete") - (failed . "failed"))) + (failed . "failed") + (ignored . "ignored"))) (define (create-deployment conn user-id instance-id) (value-at (query conn @@ -660,7 +661,8 @@ where user_id=$1;" (5 . "adding-wordpress-app") (6 . "adding-lldap-app") (7 . "adding-authelia-app") - (8 . "adding-backblaze-bucket-name-and-id"))) + (8 . "adding-backblaze-bucket-name-and-id") + (9 . "extend-deployment-status-add-ignored"))) (define (run-pending-migrations conn) (let* ((migration-ids (sort (map car *migrations*) <)) diff --git a/src/migrations/9-extend-deployment-status-add-ignored-up.sql b/src/migrations/9-extend-deployment-status-add-ignored-up.sql new file mode 100644 index 0000000..28bc174 --- /dev/null +++ b/src/migrations/9-extend-deployment-status-add-ignored-up.sql @@ -0,0 +1 @@ +alter type deployment_status add value 'ignored'; diff --git a/src/nassella.scm b/src/nassella.scm index 1c3a040..fc109fb 100644 --- a/src/nassella.scm +++ b/src/nassella.scm @@ -1915,50 +1915,59 @@ chmod -R 777 /opt/keys"))) (with-db/transaction (lambda (db) (get-user-app-config db (session-user-id) instance-id)))) + (first-deployment? (not (with-db/transaction (lambda (db) (get-most-recent-deployment-status db user-id instance-id))))) (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id)))) (dir (deployment-directory user-id instance-id)) (backup-request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000)))) - (with-db/transaction - (lambda (db) - (update-deployment-progress db deployment-id '((instance-backup . in-progress))))) - ;; ;; TODO does this handle new deployments? We should not do a back up if this is new! - (handle-exceptions - exn - (with-db/transaction - (lambda (db) - (update-deployment-progress db deployment-id '((instance-backup . failed))))) - (send-instance-control-command - (alist-ref 'root-domain app-config) - (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) - "queue-restic-snapshot-no-restart" - (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) - `((path . "/") - (tag . "automated_pre_instance_update") - ;; effectively a guid, we just want something unique - (request_id . ,backup-request-id) - (version . 0)))) + (if first-deployment? + (with-db/transaction + (lambda (db) + (update-deployment-progress db deployment-id '((instance-backup . ignored) + (machine-destroy . ignored) + (ip-destroy . ignored) + (volume-destroy . ignored))))) + (begin + (with-db/transaction + (lambda (db) + (update-deployment-progress db deployment-id '((instance-backup . in-progress))))) + (handle-exceptions + exn + (with-db/transaction + (lambda (db) + (update-deployment-progress db deployment-id '((instance-backup . failed))))) + (send-instance-control-command + (alist-ref 'root-domain app-config) + (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) + "queue-restic-snapshot-no-restart" + (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) + `((path . "/") + (tag . "automated_pre_instance_update") + ;; effectively a guid, we just want something unique + (request_id . ,backup-request-id) + (version . 0)))))) (thread-start! (lambda () - (let ((start-time (time->seconds (current-time)))) - (let loop () - (thread-sleep! 1) - (let* ((status-result - (handle-exceptions - exn - '((status . "error")) - (send-instance-control-command - (alist-ref 'root-domain app-config) - (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) - "restic-snapshot-status" - (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) - `((request_id . ,backup-request-id) - (version . 0))))) - (complete (string=? (alist-ref 'status status-result) "complete"))) - (if (or complete (> (- (time->seconds (current-time)) start-time) 120)) - (with-db/transaction - (lambda (db) - (update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed)))))) - (loop))))) + (when (not first-deployment?) + (let ((start-time (time->seconds (current-time)))) + (let loop () + (thread-sleep! 1) + (let* ((status-result + (handle-exceptions + exn + '((status . "error")) + (send-instance-control-command + (alist-ref 'root-domain app-config) + (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) + "restic-snapshot-status" + (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) + `((request_id . ,backup-request-id) + (version . 0))))) + (complete (string=? (alist-ref 'status status-result) "complete"))) + (if (or complete (> (- (time->seconds (current-time)) start-time) 120)) + (with-db/transaction + (lambda (db) + (update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed)))))) + (loop)))))) (change-directory dir) (let ((pid (process-run "make preapply && make apply > make-out 2>&1"))) (with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid))) @@ -2034,10 +2043,12 @@ chmod -R 777 /opt/keys"))) ((complete) "Complete!") ((failed) "Failed")))) (ul ,@(map (lambda (x) - `(li (HStack (@ (style ((align-items "center") - (margin-bottom ,($ 'gap.gutter))))) - (Deployment-Status-Pill (@ (status ,(alist-ref (car x) progress)))) - ,(cdr x)))) + (if (eq? (alist-ref (car x) progress) 'ignored) + '() + `((li (HStack (@ (style ((align-items "center") + (margin-bottom ,($ 'gap.gutter))))) + (Deployment-Status-Pill (@ (status ,(alist-ref (car x) progress)))) + ,(cdr x)))))) '((instance-backup . "Backup Instance") (generate-configs . "Generate Custom Image") (custom-image . "Upload Flatcar Image")