First stage refactor for dynamic app specs (napps.scm).
This commit is contained in:
151
src/db.scm
151
src/db.scm
@@ -306,45 +306,45 @@ returning users.user_id;"
|
||||
`(,(string->symbol (cdr config)) . ,(car config)))
|
||||
*user-selected-apps-column-map*))
|
||||
|
||||
;; (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))
|
||||
;; (error (string-append "Not a valid app key: " (->string (car app))))))
|
||||
;; app-alist))
|
||||
;; (query* conn
|
||||
;; (string-append
|
||||
;; "update user_selected_apps set "
|
||||
;; (string-intersperse
|
||||
;; (map-in-order (lambda (app i)
|
||||
;; (conc (alist-ref (car app) *user-selected-apps-column-map*)
|
||||
;; "=$" i))
|
||||
;; app-alist
|
||||
;; (iota (length app-alist) 3))
|
||||
;; ", ")
|
||||
;; " where user_id=$1 and instance_id=$2;")
|
||||
;; `(,user-id
|
||||
;; ,instance-id
|
||||
;; ,@(map-in-order cdr 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))
|
||||
(error (string-append "Not a valid app key: " (->string (car app))))))
|
||||
app-alist))
|
||||
(query* conn
|
||||
(string-append
|
||||
"update user_selected_apps set "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (app i)
|
||||
(conc (alist-ref (car app) *user-selected-apps-column-map*)
|
||||
"=$" i))
|
||||
app-alist
|
||||
(iota (length app-alist) 3))
|
||||
", ")
|
||||
" where user_id=$1 and instance_id=$2;")
|
||||
`(,user-id
|
||||
,instance-id
|
||||
,@(map-in-order cdr app-alist))))
|
||||
(for-each (lambda (app-version)
|
||||
(query conn "insert into user_selected_apps (app_id, installed_version)
|
||||
select apps.id, $2 from apps where apps.app_name=$1
|
||||
on conflict (app_id)
|
||||
do update set installed_version=$2 where app_id=apps.id
|
||||
from apps where apps.app_name=$1;"
|
||||
(car app-version) (cdr app-version)))
|
||||
app-alist))
|
||||
|
||||
(define (get-user-selected-apps conn user-id instance-id)
|
||||
(let ((res (row-alist
|
||||
(query conn
|
||||
(string-append
|
||||
"select "
|
||||
(string-intersperse
|
||||
(map-in-order cdr *user-selected-apps-column-map*)
|
||||
", ")
|
||||
" 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))
|
||||
(config (alist-ref key *user-selected-apps-reverse-column-map*)))
|
||||
`(,config . ,(if (sql-null? value)
|
||||
#f
|
||||
value))))
|
||||
res)))
|
||||
(row-map*
|
||||
(lambda (name version)
|
||||
(cons (string->symbol name) version))
|
||||
(query conn "select apps.app_name, usa.installed_version from user_selected_apps usa
|
||||
join apps on apps.id = usa.app_id
|
||||
where usa.user_id=$1 and usa.instance_id=$2;"
|
||||
user-id instance-id)))
|
||||
|
||||
(define (update-user-app-config conn user-id instance-id config)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
@@ -501,42 +501,59 @@ returning users.user_id;"
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
|
||||
", ")
|
||||
", uac.root_domain, uac.config_enc, uac.instance_id, "
|
||||
"usa.wg_easy_version, usa.nextcloud_version, usa.log_viewer_version, usa.ghost_version, usa.nassella_version, usa.instance_control_version "
|
||||
", uac.root_domain, uac.config_enc, uac.instance_id "
|
||||
"from instances as i "
|
||||
"join (select instance_id, max(id) as id from deployments group by instance_id) d2 "
|
||||
"on d2.instance_id = i.instance_id "
|
||||
"join deployments d on d.id = d2.id "
|
||||
"join user_app_configs uac on uac.user_id = d.user_id and uac.instance_id = d.instance_id "
|
||||
"join user_selected_apps usa on usa.instance_id = uac.instance_id "
|
||||
"where i.user_id=$1;")
|
||||
user-id)))
|
||||
user-id))
|
||||
(instance-apps
|
||||
(row-fold*
|
||||
(lambda (app-name installed-version instance-id lookup)
|
||||
(alist-update instance-id
|
||||
`(((app-name . ,(string->symbol app-name))
|
||||
(installed-version . ,installed-version))
|
||||
,@(alist-ref instance-id lookup eqv? '()))
|
||||
lookup))
|
||||
'()
|
||||
(query
|
||||
conn
|
||||
"select apps.app_name, usa.installed_version, usa.instance_id from user_selected_apps usa
|
||||
join apps on apps.id=usa.app_id
|
||||
where user_id=$1;"
|
||||
user-id))))
|
||||
(map
|
||||
(lambda (row-num)
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
(config (alist-ref key `((root_domain . root-domain)
|
||||
(config_enc . config)
|
||||
(instance_id . instance-id)
|
||||
(wg_easy_version . wg-easy)
|
||||
(nextcloud_version . nextcloud)
|
||||
(ghost_version . ghost)
|
||||
(nassella_version . nassella)
|
||||
(log_viewer_version . log-viewer)
|
||||
(instance_control_version . instance-control)
|
||||
,@*deployments-reverse-column-map*))))
|
||||
`(,config . ,(if (sql-null? value)
|
||||
#f
|
||||
(if (and (string? value) (member config *deployments-column-map*))
|
||||
(string->symbol value)
|
||||
(if (eq? key 'config_enc)
|
||||
(with-input-from-string
|
||||
(user-decrypt-from-db value user-key user-iv user-id)
|
||||
read)
|
||||
value))))))
|
||||
(row-alist res row-num)))
|
||||
(iota (row-count res))))))
|
||||
(lambda (instance)
|
||||
(cons `(apps . ,(alist-ref (alist-ref 'instance-id instance) instance-apps))
|
||||
instance))
|
||||
(map
|
||||
(lambda (row-num)
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
(config (alist-ref key `((root_domain . root-domain)
|
||||
(config_enc . config)
|
||||
(instance_id . instance-id)
|
||||
;; (wg_easy_version . wg-easy)
|
||||
;; (nextcloud_version . nextcloud)
|
||||
;; (ghost_version . ghost)
|
||||
;; (nassella_version . nassella)
|
||||
;; (log_viewer_version . log-viewer)
|
||||
;; (instance_control_version . instance-control)
|
||||
,@*deployments-reverse-column-map*))))
|
||||
`(,config . ,(if (sql-null? value)
|
||||
#f
|
||||
(if (and (string? value) (member config *deployments-column-map*))
|
||||
(string->symbol value)
|
||||
(if (eq? key 'config_enc)
|
||||
(with-input-from-string
|
||||
(user-decrypt-from-db value user-key user-iv user-id)
|
||||
read)
|
||||
value))))))
|
||||
(row-alist res row-num)))
|
||||
(iota (row-count res)))))))
|
||||
|
||||
(define (update-user-terraform-state conn user-id instance-id state backup)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
@@ -629,7 +646,9 @@ returning users.user_id;"
|
||||
(define *migrations*
|
||||
'((0 . "adding-instance-control-app")
|
||||
(1 . "adding-service-config-digitalocean-volume-size")
|
||||
(2 . "adding-deployments-instance-backup")))
|
||||
(2 . "adding-deployments-instance-backup")
|
||||
(3 . "normalizing-apps")
|
||||
(4 . "fixing-app-normalization")))
|
||||
|
||||
(define (run-pending-migrations conn)
|
||||
(let* ((migration-ids (sort (map car *migrations*) <))
|
||||
|
||||
Reference in New Issue
Block a user