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

First stage refactor for dynamic app specs (napps.scm).

Browse Source
This commit is contained in:
Thomas Hintz
2026-07-02 19:39:56 -07:00
parent 868e00ac41
commit 04407b16b0
49 changed files with 420 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/db-init.sql
View File

@@ -33,6 +33,19 @@ create table user_service_configs(
);
create unique index user_service_configs_user_id_instance_id_idx on user_service_configs (user_id, instance_id);
create table apps(
id bigserial primary key,
app_name varchar(255)
);
create unique index apps_app_name_idx on apps (app_name);
insert into apps(app_name) values ('wg-easy');
insert into apps(app_name) values ('nextcloud');
insert into apps(app_name) values ('nassella');
insert into apps(app_name) values ('log-viewer');
insert into apps(app_name) values ('ghost');
insert into apps(app_name) values ('instance-control');
create table user_selected_apps(
id bigserial primary key,
user_id integer not null references users on delete cascade,
@@ -42,9 +55,11 @@ create table user_selected_apps(
nassella_version varchar(100),
log_viewer_version varchar(100),
ghost_version varchar(100),
instance_control_version varchar(100)
instance_control_version varchar(100),
app_id integer not null references apps on delete cascade,
installed_version varchar(100)
);
create unique index user_selected_apps_user_id_instance_id_idx on user_selected_apps (user_id, instance_id);
create unique index user_selected_apps_app_id_user_id_instance_id_idx on user_selected_apps(user_id, app_id, instance_id);
create table user_app_configs(
id bigserial primary key,

151
src/db.scm
View File

@@ -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*) <))

11
src/migrations/3-normalizing-apps-down.sql Normal file
View File

@@ -0,0 +1,11 @@
begin;
delete from apps;
drop index apps_app_name_idx;
drop index user_selected_apps_app_id_user_id_idx;
drop table apps cascade;
alter table user_selected_apps drop column app_id;
alter table user_selected_apps drop column installed_version;
commit;

81
src/migrations/3-normalizing-apps-up.sql Normal file
View File

@@ -0,0 +1,81 @@
begin;
create table apps(
id bigserial primary key,
app_name varchar(255)
);
create unique index apps_app_name_idx on apps (app_name);
insert into apps(app_name) values ('wg-easy');
insert into apps(app_name) values ('nextcloud');
insert into apps(app_name) values ('nassella');
insert into apps(app_name) values ('log-viewer');
insert into apps(app_name) values ('ghost');
insert into apps(app_name) values ('instance-control');
alter table user_selected_apps add app_id integer references apps on delete cascade;
alter table user_selected_apps add installed_version varchar(100);
create index user_selected_apps_app_id_user_id_idx on user_selected_apps(user_id, app_id);
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='wg-easy'
where usa.wg_easy_version is not null;
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='nextcloud'
where usa.nextcloud_version is not null;
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='nassella'
where usa.nassella_version is not null;
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='log-viewer'
where usa.log_viewer_version is not null;
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='ghost'
where usa.ghost_version is not null;
insert into user_selected_apps (user_id, instance_id, app_id)
select usa.user_id, usa.instance_id, apps.id from user_selected_apps usa
join apps on apps.app_name='instance-control'
where usa.instance_control_version is not null;
update user_selected_apps set installed_version='15' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='wg-easy';
update user_selected_apps set installed_version='34' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='nextcloud';
update user_selected_apps set installed_version='6' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='ghost';
update user_selected_apps set installed_version='b0.0.1' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='nassella';
update user_selected_apps set installed_version='b0.0.1' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='instance-control';
update user_selected_apps set installed_version='10.6.6' from apps
where user_selected_apps.app_id=apps.id
and apps.app_name='log-viewer';
delete from user_selected_apps where wg_easy_version is not null;
delete from user_selected_apps where nextcloud_version is not null;
delete from user_selected_apps where nassella_version is not null;
delete from user_selected_apps where log_viewer_version is not null;
delete from user_selected_apps where ghost_version is not null;
delete from user_selected_apps where instance_control_version is not null;
commit;

6
src/migrations/4-fixing-app-normalization-up.sql Normal file
View File

@@ -0,0 +1,6 @@
begin;
drop index user_selected_apps_app_id_user_id_idx;
create unique index user_selected_apps_app_id_user_id_instance_id_idx on user_selected_apps(user_id, app_id, instance_id);
end;

127
src/nassella.scm
View File

@@ -1124,9 +1124,9 @@ chmod -R 777 /opt/keys")))
db
(session-user-id)
instance-id
`((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "15.1.0") (sql-null)))
(nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "31.0.8") (sql-null)))
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6.10.0") (sql-null)))
`((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "15") (sql-null)))
(nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "34") (sql-null)))
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6") (sql-null)))
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") (sql-null)))
(instance-control . "b0.0.1")))
(update-root-domain db
@@ -1364,7 +1364,7 @@ chmod -R 777 /opt/keys")))
(get-user-selected-apps db (session-user-id) instance-id))))
(app-config . ,(get-user-app-config db (session-user-id) instance-id))
(service-config . ,(get-user-service-config db (session-user-id) instance-id))))))
(selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
(selected-apps (alist-ref 'selected-apps results))
(app-config (alist-ref 'app-config results))
(config (alist-ref 'config app-config))
(root-domain (alist-ref 'root-domain app-config))
@@ -1405,16 +1405,13 @@ chmod -R 777 /opt/keys")))
(results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-user-id) instance-id))))
`((selected-apps . ,(get-user-selected-apps db (session-user-id) instance-id))
(app-config . ,(get-user-app-config db (session-user-id) instance-id))
(service-config . ,(get-user-service-config db (session-user-id) instance-id))
(terraform-state . ,(get-user-terraform-state db (session-user-id) instance-id))
(ssh-pub-key . ,(get-instance-ssh-pub-key db (session-user-id) instance-id))
(restic-password . ,(get-instance-restic-password db (session-user-id) instance-id))))))
(selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
(selected-apps (alist-ref 'selected-apps results))
(app-config (alist-ref 'app-config results))
(config (alist-ref 'config app-config))
(root-domain (alist-ref 'root-domain app-config))
@@ -1430,10 +1427,12 @@ chmod -R 777 /opt/keys")))
(write-config-entry (car e) (cdr e)))
`(("ROOT_DOMAIN" . ,root-domain)
("APP_CONFIGS" . ,(string-intersperse
(map (lambda (app)
(conc (if (eq? app 'log-viewer) 'dozzle app)
(map (lambda (app-version)
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
","
(alist-ref 'subdomain (alist-ref app config))))
(alist-ref 'subdomain (alist-ref (car app-version) config))
","
(if (eq? (car app-version) 'log-viewer) "20" (cdr app-version)))) ;; stop doing this weirdly for dozzle haha
selected-apps)
" "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
@@ -1501,43 +1500,43 @@ chmod -R 777 /opt/keys")))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . in-progress)))))
(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 apply > make-out 2>&1")))
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
@@ -1644,29 +1643,17 @@ chmod -R 777 /opt/keys")))
"deployed successfully"
(alist-ref 'status instance)))
(h3 "Apps")
(ul ,@(filter
identity
(map (lambda (app-map)
(let ((app (car app-map))
(doc-url (cdr app-map)))
(if (or (alist-ref app instance)
(eq? app 'log-viewer))
`((li (a (@ (href ,doc-url)) ,app)
" (v" ,(alist-ref app instance eq? "-") ") "
(a (@ (href "https://"
,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain))
,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain)))
#f)))
;; TODO update links
'((wg-easy . "https://wg-easy.github.io/wg-easy/Pre-release/")
(nextcloud . "https://nextcloud.com/support/")
(ghost . "https://nextcloud.com/support/")
(nassella . "https://nextcloud.com/support/")
(log-viewer . "https://nextcloud.com/support/")
;; (instance-control . "https://nextcloud.com/support/")
))))
(ul ,@(map (lambda (app-info)
(let ((app (alist-ref 'app-name app-info)))
`((li (a (@ (href "#")) ,app) ;; TODO documentation URL
" (v" ,(alist-ref 'installed-version app-info) ") "
(a (@ (href "https://"
,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain))
,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain)))))
(or (alist-ref 'apps instance) ;; TODO this really should not happen maybe?
'())))
(h3 "Actions")
(ul (li (a (@ (href "/config/wizard/services/"
,(alist-ref 'instance-id instance)))