nassella/app
1
0
Fork 0
Code Issues 33 Pull Requests Packages Projects 1 Releases Wiki Activity

Re-enable backups before deploy and cleanup old TODOs

Browse Source
This commit is contained in:
Thomas Hintz
2026-07-10 18:31:14 -07:00
parent 4115922257
commit 1019377cd8
1 changed files with 35 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

80
src/nassella.scm
View File

@@ -567,8 +567,6 @@ h1, h2, h3, h4, h5, h6 {
(json-parsers (cons array-as-list-parser (json-parsers))) (json-parsers (cons array-as-list-parser (json-parsers)))
;; TODO change username to to a prod API key that has read access
;; to the checkout session
(define (send-stripe-request #!key (method 'GET) endpoint (body #f) (username "")) (define (send-stripe-request #!key (method 'GET) endpoint (body #f) (username ""))
(define api-endpoint "https://api.stripe.com/") (define api-endpoint "https://api.stripe.com/")
(define api-version "/v1") (define api-version "/v1")
@@ -980,8 +978,6 @@ chmod -R 777 /opt/keys")))
(generate-restic-password)))))) (generate-restic-password))))))
(redirect (conc "/config/wizard/services/" instance-id)))) (redirect (conc "/config/wizard/services/" instance-id))))
;; TODO should all these key related form fields be of type password
;; so the browser doesn't save them???
(get/widgets (get/widgets
("/config/wizard/services/:id") ("/config/wizard/services/:id")
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1591,43 +1587,43 @@ chmod -R 777 /opt/keys")))
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . in-progress))))) (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! ;; ;; TODO does this handle new deployments? We should not do a back up if this is new!
;; (handle-exceptions (handle-exceptions
;; exn exn
;; (with-db/transaction (with-db/transaction
;; (lambda (db) (lambda (db)
;; (update-deployment-progress db deployment-id '((instance-backup . failed))))) (update-deployment-progress db deployment-id '((instance-backup . failed)))))
;; (send-instance-control-command (send-instance-control-command
;; (alist-ref 'root-domain app-config) (alist-ref 'root-domain app-config)
;; (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
;; "queue-restic-snapshot-no-restart" "queue-restic-snapshot-no-restart"
;; (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
;; `((path . "/") `((path . "/")
;; (tag . "automated_pre_instance_update") (tag . "automated_pre_instance_update")
;; ;; effectively a guid, we just want something unique ;; effectively a guid, we just want something unique
;; (request_id . ,backup-request-id) (request_id . ,backup-request-id)
;; (version . 0)))) (version . 0))))
(thread-start! (thread-start!
(lambda () (lambda ()
;; (let ((start-time (time->seconds (current-time)))) (let ((start-time (time->seconds (current-time))))
;; (let loop () (let loop ()
;; (thread-sleep! 1) (thread-sleep! 1)
;; (let* ((status-result (let* ((status-result
;; (handle-exceptions (handle-exceptions
;; exn exn
;; '((status . "error")) '((status . "error"))
;; (send-instance-control-command (send-instance-control-command
;; (alist-ref 'root-domain app-config) (alist-ref 'root-domain app-config)
;; (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config))) (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
;; "restic-snapshot-status" "restic-snapshot-status"
;; (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config))) (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
;; `((request_id . ,backup-request-id) `((request_id . ,backup-request-id)
;; (version . 0))))) (version . 0)))))
;; (complete (string=? (alist-ref 'status status-result) "complete"))) (complete (string=? (alist-ref 'status status-result) "complete")))
;; (if (or complete (> (- (time->seconds (current-time)) start-time) 120)) (if (or complete (> (- (time->seconds (current-time)) start-time) 120))
;; (with-db/transaction (with-db/transaction
;; (lambda (db) (lambda (db)
;; (update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed)))))) (update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed))))))
;; (loop))))) (loop)))))
(change-directory dir) (change-directory dir)
(let ((pid (process-run "make preapply && make apply > make-out 2>&1"))) (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))) (with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
@@ -1910,12 +1906,6 @@ chmod -R 777 /opt/keys")))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id progress) (update-deployment-progress db deployment-id progress)
;; TODO THIS DOESN'T WORK RIGHT FOR TERRAFORM OP FAILURES
;; like the random digital ocean error saying the IP can't be
;; updated because another operation is in progress.
;; it still registers as "success".
;; probably need to also write stderr to a file and read/store/parse that?
;; Should we parse make-out for string "Apply complete!" ?
(update-deployment-status (update-deployment-status
db user-id deployment-id db user-id deployment-id
(if exit-normal 'complete 'failed) (if exit-normal 'complete 'failed)