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

Refactor to support multiple instances.

Browse Source
This commit is contained in:
Thomas Hintz
2025-11-30 20:13:51 -08:00
parent e372f2157b
commit 284b4c37f4
4 changed files with 418 additions and 327 deletions
Download Patch File Download Diff File Expand all files Collapse all files

175
src/db.scm
View File

@@ -6,6 +6,7 @@
with-db with-db/transaction
create-user delete-user
create-instance get-user-instances
update-user-service-config get-user-service-config
update-user-selected-apps get-user-selected-apps
update-user-app-config get-user-app-config
@@ -135,15 +136,25 @@ returning users.user_id;"
(string-append (blob->hexstring/uppercase (string->blob enc-user-key))
(blob->hexstring/uppercase (string->blob tag)))
user-iv))))
(query conn "insert into user_service_configs(user_id) values ($1);" user-id)
(query conn "insert into user_selected_apps(user_id) values ($1);" user-id)
(query conn "insert into user_app_configs(user_id) values ($1);" user-id)
(query conn "insert into user_terraform_state(user_id) values ($1);" user-id)
user-id))))
(define (delete-user conn user-id)
(query conn "delete from users where user_id=$1;" user-id))
(define (create-instance conn user-id)
(let ((instance-id
(value-at
(query conn
"insert into instances(user_id) values ($1) returning instances.instance_id;" user-id))))
(query conn "insert into user_service_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
(query conn "insert into user_selected_apps(user_id, instance_id) values ($1, $2);" user-id instance-id)
(query conn "insert into user_app_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
(query conn "insert into user_terraform_state(user_id, instance_id) values ($1, $2);" user-id instance-id)
instance-id))
(define (get-user-instances conn user-id)
(column-values (query conn "select instance_id from instances where user_id=$1;" user-id)))
(define *user-service-configs-column-map*
'((cloudflare-api-token . ("cloudflare_api_token_enc" #t))
(cloudflare-account-id . ("cloudflare_account_id_enc" #t))
@@ -160,7 +171,7 @@ returning users.user_id;"
`(,(string->symbol (cadr config)) . (,(car config) ,(caddr config))))
*user-service-configs-column-map*))
(define (update-user-service-config conn user-id update-alist)
(define (update-user-service-config conn user-id instance-id update-alist)
(let ((valid-keys (map car *user-service-configs-column-map*)))
(for-each (lambda (update)
(if (not (memq (car update) valid-keys))
@@ -176,17 +187,18 @@ returning users.user_id;"
(conc (car (alist-ref (car update) *user-service-configs-column-map*))
"=$" i))
update-alist
(iota (length update-alist) 2))
(iota (length update-alist) 3))
", ")
" where user_id=$1;")
(cons user-id
(map-in-order (lambda (update)
(if (cadr (alist-ref (car update) *user-service-configs-column-map*))
(user-encrypt-for-db (cdr update) user-key user-iv user-id)
(cdr update)))
update-alist)))))
" where user_id=$1 and instance_id=$2;")
`(,user-id
,instance-id
,@(map-in-order (lambda (update)
(if (cadr (alist-ref (car update) *user-service-configs-column-map*))
(user-encrypt-for-db (cdr update) user-key user-iv user-id)
(cdr update)))
update-alist)))))
(define (get-user-service-config conn user-id)
(define (get-user-service-config conn user-id instance-id)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
(let ((res (row-alist
@@ -198,8 +210,8 @@ returning users.user_id;"
(car (alist-ref (car update) *user-service-configs-column-map*)))
*user-service-configs-column-map*)
", ")
" from user_service_configs where user_id=$1;")
user-id))))
" from user_service_configs where user_id=$1 and instance_id=$2;")
user-id instance-id))))
(map (lambda (item)
(let* ((key (car item))
(value (cdr item))
@@ -221,7 +233,7 @@ returning users.user_id;"
`(,(string->symbol (cdr config)) . ,(car config)))
*user-selected-apps-column-map*))
(define (update-user-selected-apps conn user-id app-alist)
(define (update-user-selected-apps conn user-id instance-id app-alist)
(let ((valid-keys (map car *user-selected-apps-column-map*)))
(for-each (lambda (app)
(if (not (memq (car app) valid-keys))
@@ -235,13 +247,14 @@ returning users.user_id;"
(conc (alist-ref (car app) *user-selected-apps-column-map*)
"=$" i))
app-alist
(iota (length app-alist) 2))
(iota (length app-alist) 3))
", ")
" where user_id=$1;")
(cons user-id
(map-in-order cdr app-alist))))
" where user_id=$1 and instance_id=$2;")
`(,user-id
,instance-id
,@(map-in-order cdr app-alist))))
(define (get-user-selected-apps conn user-id)
(define (get-user-selected-apps conn user-id instance-id)
(let ((res (row-alist
(query conn
(string-append
@@ -249,8 +262,8 @@ returning users.user_id;"
(string-intersperse
(map-in-order cdr *user-selected-apps-column-map*)
", ")
" from user_selected_apps where user_id=$1;")
user-id))))
" from user_selected_apps where user_id=$1 and instance_id=$2;")
user-id instance-id))))
(map (lambda (item)
(let* ((key (car item))
(value (cdr item))
@@ -260,30 +273,31 @@ returning users.user_id;"
value))))
res)))
(define (update-user-app-config conn user-id config)
(define (update-user-app-config conn user-id instance-id config)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
(query conn
"update user_app_configs set config_enc=$1 where user_id=$2;"
"update user_app_configs set config_enc=$1 where user_id=$2 and instance_id=$3;"
(user-encrypt-for-db
(with-output-to-string
(lambda ()
(write config)))
user-key user-iv user-id)
user-id)))
user-id instance-id)))
(define (update-root-domain conn user-id root-domain)
(define (update-root-domain conn user-id instance-id root-domain)
(query conn
"update user_app_configs set root_domain=$1 where user_id=$2;"
"update user_app_configs set root_domain=$1 where user_id=$2 and instance_id=$3;"
root-domain
user-id))
user-id
instance-id))
(define (get-user-app-config conn user-id)
(define (get-user-app-config conn user-id instance-id)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
(let ((res (row-alist (query conn
"select root_domain, config_enc from user_app_configs where user_id=$1;"
user-id))))
"select root_domain, config_enc from user_app_configs where user_id=$1 and instance_id=$2;"
user-id instance-id))))
`((root-domain . ,(if (sql-null? (alist-ref 'root_domain res))
#f
(alist-ref 'root_domain res)))
@@ -298,11 +312,11 @@ returning users.user_id;"
(in-progress . "in-progress")
(complete . "complete")
(failed . "failed")))
(define (create-deployment conn user-id)
(define (create-deployment conn user-id instance-id)
(value-at
(query conn
"insert into deployments(user_id, started) values($1, now()) returning deployments.id;"
user-id)))
"insert into deployments(user_id, instance_id, started) values($1, $2, now()) returning deployments.id;"
user-id instance-id)))
(define (update-deployment-in-progress conn deployment-id pid)
(query conn
"update deployments set status=$1, pid=$2 where id=$3;"
@@ -319,8 +333,8 @@ returning users.user_id;"
(define (get-deployment-status conn deployment-id)
(value-at (query conn "select status from deployments where id=$1;" deployment-id)))
(define (get-most-recent-deployment-status conn user-id)
(value-at (query conn "select status from deployments where user_id=$1 order by id DESC limit 1;" user-id)))
(define (get-most-recent-deployment-status conn user-id instance-id)
(value-at (query conn "select status from deployments where user_id=$1 and instance_id=$2 order by id DESC limit 1;" user-id instance-id)))
(define *deployments-column-map*
'((generate-configs . "generate_configs")
@@ -328,7 +342,8 @@ returning users.user_id;"
(machine-create . "terraform_machine_create")
(machine-destroy . "terraform_machine_destroy")
(status . "status")
(id . "id")))
(id . "id")
(instance-id . "instance_id")))
(define *deployments-reverse-column-map*
(map (lambda (config)
@@ -374,7 +389,7 @@ returning users.user_id;"
(string->symbol value)))))
res)))
(define (get-most-recent-deployment-progress conn user-id)
(define (get-most-recent-deployment-progress conn user-id instance-id)
(let ((res (row-alist
(query conn
(string-append
@@ -382,57 +397,64 @@ returning users.user_id;"
(string-intersperse
(map-in-order cdr *deployments-column-map*)
", ")
" from deployments where user_id=$1 order by id DESC limit 1;")
user-id))))
" from deployments where user_id=$1 and instance_id=$2 order by id DESC limit 1;")
user-id instance-id))))
(map (lambda (item)
(let* ((key (car item))
(value (cdr item))
(config (alist-ref key *deployments-reverse-column-map*)))
`(,config . ,(if (sql-null? value)
#f
(string->symbol value)))))
(if (string? value)
(string->symbol value)
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))))
(let* ((res-raw
(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 and uac.instance_id = d.instance_id"
" where d.user_id=$1 order by d.id DESC limit 1;")
user-id))
(res (if (> (row-count res-raw) 0) (row-alist res-raw) '())))
(if (null? res)
'()
;; I think this is just a hack as currently we only return 1 deployment
(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)
(define (update-user-terraform-state conn user-id instance-id state backup)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
(query conn
"update user_terraform_state set state_enc=$1, state_backup_enc=$2 where user_id=$3;"
"update user_terraform_state set state_enc=$1, state_backup_enc=$2 where user_id=$3 and instance_id=$4;"
(user-encrypt-for-db state user-key user-iv user-id)
(user-encrypt-for-db backup user-key user-iv user-id)
user-id)))
user-id
instance-id)))
(define (get-user-terraform-state conn user-id)
(define (get-user-terraform-state conn user-id instance-id)
(receive (user-key user-iv auth-user-id)
(get-decrypted-user-key-and-iv conn user-id)
(let ((res (row-alist (query conn
"select state_enc, state_backup_enc from user_terraform_state where user_id=$1;"
user-id))))
"select state_enc, state_backup_enc from user_terraform_state where user_id=$1 and instance_id=$2;"
user-id instance-id))))
`((state . ,(if (sql-null? (alist-ref 'config_enc res))
""
(user-decrypt-from-db (alist-ref 'state_enc res) user-key user-iv user-id)))
@@ -440,15 +462,15 @@ 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-user-deployments db 1)))
;; (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)))))
;; (with-db/transaction
;; (lambda (db)
;; (update-user-terraform-state db 7
;; (with-input-from-file "src/deploy-bak/terraform.tfstate" read-string)
;; (with-input-from-file "src/deploy-bak/terraform.tfstate.backup" read-string))))
;; (update-user-terraform-state db 1 22
;; (with-input-from-file "src/deploy-7/terraform.tfstate" read-string)
;; (with-input-from-file "src/deploy-7/terraform.tfstate.backup" read-string))))
;; (with-db/transaction (lambda (db) (get-user-terraform-state db 7)))
;; (with-db/transaction (lambda (db) (create-deployment db 7)))
@@ -458,6 +480,7 @@ returning users.user_id;"
;; (with-db/transaction (lambda (db) (get-most-recent-deployment-status db 7)))
;; (with-db/transaction (lambda (db) (create-user db 1 "t@thintz.com" "thecombjelly")))
;; (with-db/transaction (lambda (db) (create-instance db 2)))
;; (let ((user-id 7))
;; (with-db/transaction