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

Initial sketch of dashboard.

Browse Source
This commit is contained in:
Thomas Hintz
2025-11-15 12:34:29 -08:00
parent 908938dd41
commit 5ca856b1ff
2 changed files with 66 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
src/db.scm
View File

@@ -17,6 +17,7 @@
update-deployment-progress get-deployment-progress
get-most-recent-deployment-progress
update-user-terraform-state get-user-terraform-state
get-user-deployments
)
(import scheme
@@ -328,7 +329,9 @@ returning users.user_id;"
'((generate-configs . "generate_configs")
(custom-image . "terraform_custom_image")
(machine-create . "terraform_machine_create")
(machine-destroy . "terraform_machine_destroy")))
(machine-destroy . "terraform_machine_destroy")
(status . "status")
(id . "id")))
(define *deployments-reverse-column-map*
(map (lambda (config)
@@ -393,6 +396,31 @@ returning users.user_id;"
(string->symbol value)))))
res)))
(define (get-user-deployments conn user-id)
(let ((res (row-alist
(query conn
(string-append
"select "
(string-intersperse
(map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
", ")
", uac.root_domain"
" from deployments as d "
"join user_app_configs uac on uac.user_id = d.user_id"
" where d.user_id=$1 order by d.id DESC limit 1;")
user-id))))
(list
(map (lambda (item)
(let* ((key (car item))
(value (cdr item))
(config (alist-ref key (cons '(root_domain . root-domain) *deployments-reverse-column-map*))))
`(,config . ,(if (sql-null? value)
#f
(if (string? value)
(string->symbol value)
value)))))
res))))
(define (update-user-terraform-state conn user-id state backup)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
@@ -415,6 +443,7 @@ returning users.user_id;"
""
(user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
(with-db/transaction (lambda (db) (get-user-deployments db 7)))
;; (with-db/transaction (lambda (db) (get-most-recent-deployment-progress db 7)))
;; (with-db/transaction (lambda (db) (get-deployment-progress db 14)))
;; (with-db/transaction (lambda (db) (update-deployment-progress db 14 '((generate-configs . complete) (custom-image . in-progress) (machine-create . queued)))))