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

Working snapshot create webflow.

Browse Source
This commit is contained in:
Thomas Hintz
2026-05-24 10:28:46 -07:00
parent 27d71d744b
commit d1e8e0b5dc
1 changed files with 60 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
src/nassella.scm
View File

@@ -13,6 +13,7 @@
(chicken file) (chicken file)
(chicken condition) (chicken condition)
(chicken sort) (chicken sort)
(chicken random)
(rename srfi-1 (delete srfi1:delete)) (rename srfi-1 (delete srfi1:delete))
srfi-13 srfi-13
@@ -1935,18 +1936,65 @@ chmod -R 777 /opt/keys")))
(Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Create")))))))))) (Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Create"))))))))))
(post "/backups/:instance_id/create-submit" (post "/backups/:instance_id/create-submit"
(let ((instance-id (alist-ref "instance_id" (current-params) equal?)) (let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
(app-config (with-db/transaction (app-config (with-db/transaction
(lambda (db) (lambda (db)
(get-user-app-config db (session-user-id) instance-id))))) (get-user-app-config db (session-user-id) instance-id))))
;; TODO make requests to instance control (request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000))))
;; get the root domain and subdomain for instance control (send-instance-control-command
;; then call subdomain.rootdomain/hooks/queue-restic-snapshot (alist-ref 'root-domain app-config)
;; content-type application/json (alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
;; data: 'path "/" 'tag tag 'request_id (generate-one?) 'version 0 "queue-restic-snapshot"
;; then run through hmac ((hmac "instance-control-secret-key" sha256-primitive) data) (alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
;; then make a new page to redirect the user to that polls for status page using the request id `((path . "/") ;; unused for now but we do want root until we support backing up individual apps
(redirect (conc "/config/wizard/review/" instance-id)))) (tag . ,(alist-ref 'tag (current-params)))
;; effectively a guid, we just want something unique
(request_id . ,request-id)
(version . 0)))
(redirect (conc "/backups/" instance-id "/create-success/" request-id))))
(get/widgets
("/backups/:instance_id/create-success/:request_id"
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
(request-id (alist-ref "request_id" (current-params) equal?))
(app-config (with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))
(status-result
(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 . ,request-id)
(version . 0))))
(complete (string=? (alist-ref 'status status-result) "complete")))
(if complete
'()
'((meta (@ (http-equiv "refresh") (content "5")))))))
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
(request-id (alist-ref "request_id" (current-params) equal?))
(app-config (with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))
(status-result
(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 . ,request-id)
(version . 0))))
(complete (string=? (alist-ref 'status status-result) "complete")))
`(App
(Main-Container
(VStack
(h1 ,(if complete "Snapshot Complete" "Snapshot In Progress..."))
(div
(a (@ (href "/dashboard")) "Dashboard")
,@(if complete
'()
" (snapshot will continue in the background if you leave this page)")))))))
(schematra-install) (schematra-install)