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

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