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

Postgres db integration.

Browse Source
This commit is contained in:
Thomas Hintz
2025-11-10 13:13:59 -08:00
parent 8595014fde
commit fb9c3f8daf
4 changed files with 637 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files

420
src/nassella.scm
View File

@@ -1,18 +1,25 @@
(import sxml-transforms (chicken string) (chicken port) html-widgets
(load "db.scm")
(import (chicken string)
(chicken port)
(chicken io)
(chicken pretty-print)
(chicken process)
(chicken process-context)
(rename srfi-1 (delete srfi1:delete))
html-widgets
sxml-transforms
(prefix schematra schematra:)
schematra-body-parser
schematra-session
(rename srfi-1 (delete srfi1:delete))
uri-common
http-client
medea
intarweb
(chicken io)
openssl
(chicken pretty-print)
(chicken io)
(chicken process)
(chicken process-context))
nassella-db
sql-null)
(schematra:use-middleware! (body-parser-middleware))
@@ -273,7 +280,7 @@ h1, h2, h3, h4, h5, h6 {
'((meta (@ (name "viewport") (content "width=device-width"))))
(begin
;; TODO remove once sessions are integrated
(session-set! "user-id" "12345")
(session-set! "user-id" 7)
(session-set! "username" "me")
body ...))))))))
@@ -456,41 +463,44 @@ h1, h2, h3, h4, h5, h6 {
(cursor "pointer"))))
,submit-button)))
(define *data*
'())
(get
("/config/wizard/services")
`(App
(Configuration-Wizard
(@ (step "Services"))
(form
(@ (action "/config/wizard/services-submit")
(method POST))
(VStack
(Fieldset
(@ (title "Cloudflare"))
(Field (@ (name "cloudflare-api-token") (label ("API Token")) (value ,(alist-ref 'cloudflare-api-token *data*))))
(Field (@ (name "cloudflare-zone-id") (label ("Zone ID")) (value ,(alist-ref 'cloudflare-zone-id *data*))))
(Field (@ (name "cloudflare-account-id") (label ("Account ID")) (value ,(alist-ref 'cloudflare-account-id *data*)))))
(Fieldset
(@ (title "DigitalOcean"))
(Field (@ (name "digitalocean-api-token") (label ("API Token")) (value ,(alist-ref 'digitalocean-api-token *data*)))))
(Fieldset
(@ (title "Backblaze"))
(Field (@ (name "backblaze-application-key") (label ("Application Key")) (value ,(alist-ref 'backblaze-application-key *data*))))
(Field (@ (name "backblaze-key-id") (label ("Key ID")) (value ,(alist-ref 'backblaze-key-id *data*))))
(Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (value ,(alist-ref 'backblaze-bucket-url *data*)))))
(Form-Nav))))))
(let ((config (with-db/transaction (lambda (db) (get-user-service-config db (session-get "user-id"))))))
`(App
(Configuration-Wizard
(@ (step "Services"))
(form
(@ (action "/config/wizard/services-submit")
(method POST))
(VStack
(Fieldset
(@ (title "Cloudflare"))
(Field (@ (name "cloudflare-api-token") (label ("API Token")) (value ,(alist-ref 'cloudflare-api-token config))))
(Field (@ (name "cloudflare-zone-id") (label ("Zone ID")) (value ,(alist-ref 'cloudflare-zone-id config))))
(Field (@ (name "cloudflare-account-id") (label ("Account ID")) (value ,(alist-ref 'cloudflare-account-id config)))))
(Fieldset
(@ (title "DigitalOcean"))
(Field (@ (name "digitalocean-api-token") (label ("API Token")) (value ,(alist-ref 'digitalocean-api-token config)))))
(Fieldset
(@ (title "Backblaze"))
(Field (@ (name "backblaze-application-key") (label ("Application Key")) (value ,(alist-ref 'backblaze-application-key config))))
(Field (@ (name "backblaze-key-id") (label ("Key ID")) (value ,(alist-ref 'backblaze-key-id config))))
(Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (value ,(alist-ref 'backblaze-bucket-url config)))))
(Form-Nav)))))))
(schematra:post ("/config/wizard/services-submit")
(set! *data* (alist-update 'cloudflare-api-token (alist-ref 'cloudflare-api-token (schematra:current-params)) *data*))
(set! *data* (alist-update 'cloudflare-account-id (alist-ref 'cloudflare-account-id (schematra:current-params)) *data*))
(set! *data* (alist-update 'cloudflare-zone-id (alist-ref 'cloudflare-zone-id (schematra:current-params)) *data*))
(set! *data* (alist-update 'digitalocean-api-token (alist-ref 'digitalocean-api-token (schematra:current-params)) *data*))
(set! *data* (alist-update 'backblaze-application-key (alist-ref 'backblaze-application-key (schematra:current-params)) *data*))
(set! *data* (alist-update 'backblaze-key-id (alist-ref 'backblaze-key-id (schematra:current-params)) *data*))
(set! *data* (alist-update 'backblaze-bucket-url (alist-ref 'backblaze-bucket-url (schematra:current-params)) *data*))
(with-db/transaction
(lambda (db)
(update-user-service-config
db
(session-get "user-id")
`((cloudflare-api-token . ,(alist-ref 'cloudflare-api-token (schematra:current-params)))
(cloudflare-account-id . ,(alist-ref 'cloudflare-account-id (schematra:current-params)))
(cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (schematra:current-params)))
(digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (schematra:current-params)))
(backblaze-application-key . ,(alist-ref 'backblaze-application-key (schematra:current-params)))
(backblaze-key-id . ,(alist-ref 'backblaze-key-id (schematra:current-params)))
(backblaze-bucket-url . ,(alist-ref 'backblaze-bucket-url (schematra:current-params)))))))
(schematra:redirect "/config/wizard/services-success"))
(get
@@ -517,64 +527,98 @@ h1, h2, h3, h4, h5, h6 {
(get
("/config/wizard/apps")
`(App
(Configuration-Wizard
(@ (step "Apps"))
(form
(@ (action "/config/wizard/apps-submit") (method POST))
(VStack
(Fieldset
(@ (title "Root Domain"))
(Field (@ (element select) (name "root-domain"))
(option (@ (value (alist-ref 'root-domain *data*))) "nassella.cc")))
(Fieldset
(@ (title "Selected Apps"))
(Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps *data*)))))
(Field (@ (name "nextcloud") (type "checkbox") (label ("NextCloud")) (checked ,(member 'wg-easy (alist-ref 'selected-apps *data*)))))
(Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
(Form-Nav (@ (back-to "/config/wizard/services-success"))))))))
(let ((results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-get "user-id")))))
(app-config . ,(get-user-app-config db (session-get "user-id"))))))))
`(App
(Configuration-Wizard
(@ (step "Apps"))
(form
(@ (action "/config/wizard/apps-submit") (method POST))
(VStack
(Fieldset
(@ (title "Root Domain"))
(Field (@ (element select) (name "root-domain"))
(option (@ (value ,(alist-ref 'root-domain (alist-ref 'app-config results)))) "nassella.cc"))) ;; TODO fetch from cloudflare API?
(Fieldset
(@ (title "Selected Apps"))
(Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps results)))))
(Field (@ (name "nextcloud") (type "checkbox") (label ("NextCloud")) (checked ,(member 'nextcloud (alist-ref 'selected-apps results)))))
(Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
(Form-Nav (@ (back-to "/config/wizard/services-success")))))))))
(schematra:post ("/config/wizard/apps-submit")
(set! *data* (alist-update 'root-domain (alist-ref 'root-domain (schematra:current-params)) *data*))
(set! *data* (alist-update 'selected-apps
`(,@(if (alist-ref 'wg-easy (schematra:current-params)) '(wg-easy) '())
,@(if (alist-ref 'nextcloud (schematra:current-params)) '(nextcloud) '())
log-viewer)
*data*))
(with-db/transaction
(lambda (db)
(update-user-selected-apps
db
(session-get "user-id")
`((wg-easy . ,(or (and (alist-ref 'wg-easy (schematra:current-params)) "0.0") (sql-null)))
(nextcloud . ,(or (and (alist-ref 'nextcloud (schematra:current-params)) "0.0") (sql-null)))))
(update-root-domain db (session-get "user-id") (alist-ref 'root-domain (schematra:current-params)))))
(schematra:redirect "/config/wizard/apps2"))
(get
("/config/wizard/apps2")
`(App
(Configuration-Wizard
(@ (step "Apps"))
(form
(@ (action "/config/wizard/apps2-submit") (method POST))
(VStack
,@(if (member 'wg-easy (alist-ref 'selected-apps *data*))
`((Fieldset
(@ (title "WG-Easy"))
(Field (@ (name "wg-easy-subdomain") (label ("Subdomain")) (value ,(alist-ref 'wg-easy-subdomain *data*))))))
'())
,@(if (member 'nextcloud (alist-ref 'selected-apps *data*))
`((Fieldset
(@ (title "NextCloud"))
(Field (@ (name "nextcloud-subdomain") (label ("Subdomain")) (value ,(alist-ref 'nextcloud-subdomain *data*))))
(Field (@ (name "nextcloud-admin-user") (label ("Admin Username")) (value ,(alist-ref 'nextcloud-admin-user *data*))))
(Field (@ (name "nextcloud-admin-password") (label ("Admin Password")) (type "password") (value ,(alist-ref 'nextcloud-admin-password *data*))))))
'())
(Fieldset
(@ (title "Log Viewer"))
(Field (@ (name "log-viewer-subdomain") (label ("Subdomain")) (value ,(alist-ref 'log-viewer-subdomain *data*))))
(Field (@ (name "log-viewer-user") (label ("Username")) (value ,(alist-ref 'log-viewer-user *data*))))
(Field (@ (name "log-viewer-password") (label ("Password")) (type "password") (value ,(alist-ref 'log-viewer-password *data*)))))
(Form-Nav (@ (back-to "/config/wizard/apps"))))))))
(let* ((results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-get "user-id")))))
(app-config . ,(get-user-app-config db (session-get "user-id")))))))
(selected-apps (alist-ref 'selected-apps results))
(app-config (alist-ref 'app-config results)))
`(App
(Configuration-Wizard
(@ (step "Apps"))
(form
(@ (action "/config/wizard/apps2-submit") (method POST))
(VStack
,@(if (member 'wg-easy selected-apps)
`((Fieldset
(@ (title "WG-Easy"))
(Field (@ (name "wg-easy-subdomain") (label ("Subdomain")) (value ,(alist-ref 'subdomain (alist-ref 'wg-easy app-config eq? '()) eq? "wg-easy"))))))
'())
,@(if (member 'nextcloud selected-apps)
`((Fieldset
(@ (title "NextCloud"))
(Field (@ (name "nextcloud-subdomain") (label ("Subdomain"))
(value ,(alist-ref 'subdomain (alist-ref 'nextcloud app-config eq? '()) eq? "nextcloud"))))
(Field (@ (name "nextcloud-admin-user") (label ("Admin Username"))
(value ,(alist-ref 'admin-user (alist-ref 'nextcloud app-config eq? '()) eq? "admin"))))
(Field (@ (name "nextcloud-admin-password") (label ("Admin Password")) (type "password")
(value ,(alist-ref 'admin-password (alist-ref 'nextcloud app-config eq? '()) eq? ""))))))
'())
(Fieldset
(@ (title "Log Viewer"))
(Field (@ (name "log-viewer-subdomain") (label ("Subdomain"))
(value ,(alist-ref 'subdomain (alist-ref 'log-viewer app-config eq? '()) eq? "logs"))))
(Field (@ (name "log-viewer-user") (label ("Username"))
(value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
(Field (@ (name "log-viewer-password") (label ("Password")) (type "password")
(value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? "")))))
(Form-Nav (@ (back-to "/config/wizard/apps")))))))))
(schematra:post ("/config/wizard/apps2-submit")
(set! *data* (alist-update 'nextcloud-admin-user (alist-ref 'nextcloud-admin-user (schematra:current-params)) *data*))
(set! *data* (alist-update 'nextcloud-admin-password (alist-ref 'nextcloud-admin-password (schematra:current-params)) *data*))
(set! *data* (alist-update 'log-viewer-user (alist-ref 'log-viewer-user (schematra:current-params)) *data*))
(set! *data* (alist-update 'log-viewer-password (alist-ref 'log-viewer-password (schematra:current-params)) *data*))
(with-db/transaction
(lambda (db)
(update-user-app-config
db
(session-get "user-id")
`((wg-easy . ((subdomain . ,(alist-ref 'wg-easy-subdomain (schematra:current-params)))))
(nextcloud . ((subdomain . ,(alist-ref 'nextcloud-subdomain (schematra:current-params)))
(admin-user . ,(alist-ref 'nextcloud-admin-user (schematra:current-params)))
(admin-password . ,(alist-ref 'nextcloud-admin-password (schematra:current-params)))))
(log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (schematra:current-params)))
(user . ,(alist-ref 'log-viewer-user (schematra:current-params)))
(password . ,(alist-ref 'log-viewer-password (schematra:current-params)))))))))
(schematra:redirect "/config/wizard/machine"))
;; Parsing JSON arrays as lists instead of vectors
@@ -611,30 +655,41 @@ h1, h2, h3, h4, h5, h6 {
(get
("/config/wizard/machine")
`(App
(Configuration-Wizard
(@ (step "Machine"))
(form
(@ (action "/config/wizard/machine-submit")
(method POST))
(VStack
(Fieldset
(@ (title "Region"))
(Field (@ (element select) (name "region"))
(option (@ (value "")) "")
,@(map (lambda (r)
`(option (@ (value ,(alist-ref 'slug r))) ,(alist-ref 'name r)))
(get-digital-ocean-regions (alist-ref 'digitalocean-api-token *data*)))))
(Form-Nav (@ (back-to ,(conc "/config/wizard/apps2")))))))))
(let ((config (with-db/transaction
(lambda (db)
(get-user-service-config db (session-get "user-id"))))))
`(App
(Configuration-Wizard
(@ (step "Machine"))
(form
(@ (action "/config/wizard/machine-submit")
(method POST))
(VStack
(Fieldset
(@ (title "Region"))
(Field (@ (element select) (name "region"))
(option (@ (value "")) "")
,@(map (lambda (r)
`(option (@ (value ,(alist-ref 'slug r))) ,(alist-ref 'name r)))
(get-digital-ocean-regions (alist-ref 'digitalocean-api-token config)))))
(Form-Nav (@ (back-to ,(conc "/config/wizard/apps2"))))))))))
(schematra:post ("/config/wizard/machine-submit")
(set! *data* (alist-update 'digitalocean-region (alist-ref 'region (schematra:current-params)) *data*))
(with-db/transaction
(lambda (db)
(update-user-service-config
db
(session-get "user-id")
`((digitalocean-region . ,(alist-ref 'region (schematra:current-params)))))))
(schematra:redirect "/config/wizard/machine2"))
(get
("/config/wizard/machine2")
(let* ((region (alist-ref 'digitalocean-region *data*))
(all-sizes (get-digital-ocean-sizes (alist-ref 'digitalocean-api-token *data*)))
(let* ((config (with-db/transaction
(lambda (db)
(get-user-service-config db (session-get "user-id")))))
(region (alist-ref 'digitalocean-region config))
(all-sizes (get-digital-ocean-sizes (alist-ref 'digitalocean-api-token config)))
(sizes (filter (lambda (s) (member region (alist-ref 'regions s))) all-sizes)))
`(App
(Configuration-Wizard
@@ -657,74 +712,107 @@ h1, h2, h3, h4, h5, h6 {
(Form-Nav (@ (back-to ,(conc "/config/wizard/machine"))))))))))
(schematra:post ("/config/wizard/machine2-submit")
(set! *data* (alist-update 'digitalocean-size (alist-ref 'size (schematra:current-params)) *data*))
(with-db/transaction
(lambda (db)
(update-user-service-config
db
(session-get "user-id")
`((digitalocean-size . ,(alist-ref 'size (schematra:current-params)))))))
(schematra:redirect "/config/wizard/review"))
(get
("/config/wizard/review")
`(App
(Configuration-Wizard
(@ (step "Review"))
(h2 "Root Domain")
,(alist-ref 'root-domain *data*)
(h2 "Apps")
(ul ,@(map (lambda (app) `(li ,app " @ "
,(alist-ref (string->symbol (conc (symbol->string app) "-subdomain")) *data*)
"."
,(alist-ref 'root-domain *data*)))
(alist-ref 'selected-apps *data*)))
(h2 "Machine")
(ul (li "Region: " ,(alist-ref 'digitalocean-region *data*))
(li "Size: " ,(alist-ref 'digitalocean-size *data*)))
(form
(@ (action "/config/wizard/review-submit") (method POST))
(VStack
(Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch"))))))))
(let* ((results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-get "user-id")))))
(app-config . ,(get-user-app-config db (session-get "user-id")))
(service-config . ,(get-user-service-config db (session-get "user-id")))))))
(selected-apps (cons 'log-viewer (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))
(service-config (alist-ref 'service-config results)))
`(App
(Configuration-Wizard
(@ (step "Review"))
(h2 "Root Domain")
,root-domain
(h2 "Apps")
(ul ,@(map (lambda (app) `(li ,app " @ "
,(alist-ref 'subdomain (alist-ref app config))
"."
,root-domain))
selected-apps))
(h2 "Machine")
(ul (li "Region: " ,(alist-ref 'digitalocean-region service-config))
(li "Size: " ,(alist-ref 'digitalocean-size service-config)))
(form
(@ (action "/config/wizard/review-submit") (method POST))
(VStack
(Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch")))))))))
(define (write-config-entry name key-or-value)
(define (write-config-entry name value)
(display name)
(display "=\"")
(display (if (symbol? key-or-value) (alist-ref key-or-value *data*) key-or-value))
(display value)
(print "\""))
(schematra:post ("/config/wizard/review-submit")
(with-output-to-file "deploy/config/apps.config"
(lambda ()
(map (lambda (e)
(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)
","
(alist-ref (string->symbol (conc (symbol->string app) "-subdomain")) *data*)))
(alist-ref 'selected-apps *data*))
" "))
("HOST_ADMIN_USER" . log-viewer-user)
("HOST_ADMIN_PASSWORD" . log-viewer-password)
("NEXTCLOUD_ADMIN_USER" . nextcloud-admin-user)
("NEXTCLOUD_ADMIN_PASSWORD" . nextcloud-admin-password)
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword")
("NEXTCLOUD_REDIS_PASSWORD" . "redispassword")
("BACKBLAZE_KEY_ID" . backblaze-key-id)
("BACKBLAZE_APPLICATION_KEY" . backblaze-application-key)
("BACKBLAZE_BUCKET_URL" . backblaze-bucket-url)
("RESTIC_PASSWORD" . "foodisgood")))))
(with-output-to-file "deploy/config/production.tfvars"
(lambda ()
(map (lambda (e)
(write-config-entry (car e) (cdr e)))
`(("server_type" . digitalocean-size)
("do_token" . digitalocean-api-token)
("cloudflare_api_token" . cloudflare-api-token)
("cloudflare_zone_id" . cloudflare-zone-id)
("cloudflare_account_id" . cloudflare-account-id)
("cluster_name" . "mycluster")
("datacenter" . digitalocean-region)
("flatcar_stable_version" . "4230.2.3")))
(display "ssh_keys=[\"") (display (with-input-from-file "deploy/config/ssh-keys" read-string)) (print "\"]")))
(let* ((results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-get "user-id")))))
(app-config . ,(get-user-app-config db (session-get "user-id")))
(service-config . ,(get-user-service-config db (session-get "user-id")))))))
(selected-apps (cons 'log-viewer (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))
(service-config (alist-ref 'service-config results)))
(with-output-to-file "deploy/config/apps.config"
(lambda ()
(map (lambda (e)
(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)
","
(alist-ref 'subdomain (alist-ref app config))))
selected-apps)
" "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config)))
("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword")
("NEXTCLOUD_REDIS_PASSWORD" . "redispassword")
("BACKBLAZE_KEY_ID" . ,(alist-ref 'backblaze-key-id service-config))
("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
("RESTIC_PASSWORD" . "foodisgood")))))
(with-output-to-file "deploy/config/production.tfvars"
(lambda ()
(map (lambda (e)
(write-config-entry (car e) (cdr e)))
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
("cloudflare_api_token" . ,(alist-ref 'cloudflare-api-token service-config))
("cloudflare_zone_id" . ,(alist-ref 'cloudflare-zone-id service-config))
("cloudflare_account_id" . ,(alist-ref 'cloudflare-account-id service-config))
("cluster_name" . "mycluster")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
("flatcar_stable_version" . "4230.2.3")))
(display "ssh_keys=[\"") (display (with-input-from-file "deploy/config/ssh-keys" read-string)) (print "\"]"))))
(change-directory "deploy")
(session-set! "pid" (process-run "make apply > make-out"))
(change-directory "../")