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)))
;; 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 api-endpoint "https://api.stripe.com/")
(define api-version "/v1")
@@ -980,8 +978,6 @@ chmod -R 777 /opt/keys")))
(generate-restic-password))))))
(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
("/config/wizard/services/:id")
(let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1591,43 +1587,43 @@ chmod -R 777 /opt/keys")))
(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))))
(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)))))
(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)))
@@ -1910,12 +1906,6 @@ chmod -R 777 /opt/keys")))
(with-db/transaction
(lambda (db)
(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
db user-id deployment-id
(if exit-normal 'complete 'failed)