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

Working nassella deployment.

Browse Source
This commit is contained in:
Thomas Hintz
2026-04-08 19:54:32 -07:00
parent 265a682b52
commit dcd1df754a
21 changed files with 835 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

328
src/nassella.scm
View File

@@ -298,7 +298,11 @@ h1, h2, h3, h4, h5, h6 {
(define test-user-id (make-parameter 1))
(define (session-user-id)
(or (session-get "user-id") (test-user-id)))
(cond-expand
(dev
(or (session-get "user-id") (test-user-id)))
(else
(session-get "user-id"))))
(define-syntax get/widgets
(syntax-rules ()
@@ -314,9 +318,14 @@ h1, h2, h3, h4, h5, h6 {
headers)
;; `((meta (@ (name "viewport") (content "width=device-width"))))
(begin
;; TODO remove once sessions are integrated
(session-set! "user-id" (test-user-id))
(session-set! "username" "me")
(cond-expand
(dev
(session-set! "user-id" (test-user-id))
(session-set! "username" "me"))
(else
(let ((user-id (with-db/transaction (lambda (db) (get-user-id-by-username db (header-value 'remote-user (request-headers (current-request))))))))
(when user-id (session-set! "user-id" user-id))
(session-set! "username" (header-value 'remote-user (request-headers (current-request)))))))
body ...))))))))
(define-widget (Container ((max-width ($ 'width.main.max)) (style '())) contents)
@@ -524,6 +533,57 @@ h1, h2, h3, h4, h5, h6 {
(json-parsers (cons array-as-list-parser (json-parsers)))
;; TODO change username to to a prod API key that has read access
;; to the checkout session
(define (send-stripe-request #!key (method 'GET) endpoint (body #f) (username ""))
(define api-endpoint "https://api.stripe.com/")
(define api-version "/v1")
(with-input-from-request
(make-request method: method
uri: (uri-reference (string-append api-endpoint api-version endpoint))
headers: (headers `((authorization . (#(basic ((username . ,username) (password . ""))))))))
body
read-json))
(define (stripe-session-email sid)
(alist-ref
'email
(alist-ref
'customer_details
(send-stripe-request endpoint: (string-append "/checkout/sessions/" sid)))))
(define (create-lldap-user username email)
;; query = mutation createUser($user:CreateUserInput!){createUser(user:$user){id email displayName firstName lastName avatar}}
;; variables = {\"user\":{\"id\":\"${id}\",\"email\":\"${email}\",\"displayName\":\"${name}\",\"firstName\":\"${firstName}\",\"lastName\":\"${lastName}\",\"avatar\":\"
;; data="{\"query\":\"${query}\",\"variables\":${variables}"
;; http://localhost:17170/api/graphql
;; -H 'Content-Type: application/json' \
;; -H "Authorization: Bearer $token" \
(let ((api-token
(alist-ref
'token
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference "http://nassella_lldap:17170/auth/simple/login")
headers: (headers `((content-type application/json))))
(lambda ()
(write-json
`((username . "admin") (password . ,(string-trim-right (with-input-from-file "/run/secrets/nassella_lldap_admin_password" read-string)))))) ;; trim to remove newline
read-json))))
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference "http://nassella_lldap:17170/api/graphql")
headers: (headers `((content-type application/json)
(authorization #(,(string-append "Bearer " api-token) raw)))))
(lambda ()
(write-json
`((query . "mutation createUser($user:CreateUserInput!){createUser(user:$user){id email displayName firstName lastName avatar}}")
(variables . ((user . ((id . ,username)
(email . ,email))))))))
read-json)))
(define (get-digital-ocean-regions api-token)
(filter
(lambda (r)
@@ -733,6 +793,21 @@ chmod -R 777 /opt/keys"))
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()_-+={}[]|<>,.?")
30)))
(define (generate-jwt-secret)
(generator->string (gtake (make-random-char-generator
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()_-+={}[]|<>,.?")
32)))
(define (generate-key-seed)
(generator->string (gtake (make-random-char-generator
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()_-+={}[]|<>,.?")
32)))
(define (generate-authelia-key-seed)
(generator->string (gtake (make-random-char-generator
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
64)))
(define (generate-postgres-password)
(generator->string (gtake (make-random-char-generator
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
@@ -746,13 +821,34 @@ chmod -R 777 /opt/keys"))
(with-schematra-app app
(lambda ()
;;; UNSECURED PAGES
(get/widgets
("/unsecured/account/create")
`(App
(form
(@ (action "/unsecured/account/create-submit") (method POST))
(VStack
(Fieldset
(@ (title "Account Details"))
(Field (@ (name "username") (label ("Username"))))
(input (@ (type "hidden") (name "sid") (value ,(alist-ref 'sid (current-params) equal?))))
(Button (@ (type "submit")) "Create Account"))))))
(post "/unsecured/account/create-submit"
(let ((email (stripe-session-email (alist-ref 'sid (current-params))))
(username (alist-ref 'username (current-params))))
(create-lldap-user username email)
(with-db/transaction (lambda (db) (create-user db email username))))
(redirect "/authelia/reset-password"))
;;; REQUIRES AUTHED USER
(post "/config/wizard/create-instance"
(let* ((ssh-keys (generate-ssh-key (session-user-id)))
(instance-id (with-db/transaction
(lambda (db)
(create-instance db (session-user-id) (first ssh-keys) (second ssh-keys)
(generate-restic-password))))))
(redirect (conc "/config/wizard/services/" instance-id))))
(let* ((ssh-keys (generate-ssh-key (session-user-id)))
(instance-id (with-db/transaction
(lambda (db)
(create-instance db (session-user-id) (first ssh-keys) (second ssh-keys)
(generate-restic-password))))))
(redirect (conc "/config/wizard/services/" instance-id))))
;; TODO should all these key related form fields be of type password
;; so the browser doesn't save them???
@@ -957,7 +1053,11 @@ chmod -R 777 /opt/keys"))
,@(if (member 'nassella selected-apps)
`((Fieldset
(@ (title "Nassella"))
(Field (@ (name "nassella-subdomain") (label ("Subdomain")) (value ,(alist-ref 'subdomain (alist-ref 'nassella app-config eq? '()) eq? "nassella"))))))
(Field (@ (name "nassella-subdomain") (label ("Subdomain")) (value ,(alist-ref 'subdomain (alist-ref 'nassella app-config eq? '()) eq? "app"))))
(Field (@ (name "nassella-lldap-subdomain") (label ("LLDAP Subdomain"))
(value ,(alist-ref 'lldap-subdomain (alist-ref 'nassella app-config eq? '()) eq? "lldap"))))
(Field (@ (name "nassella-lldap-admin-password") (label ("Admin Password")) (type "password")
(value ,(alist-ref 'lldap-admin-password (alist-ref 'nassella app-config eq? '()) eq? ""))))))
'())
(Fieldset
(@ (title "Log Viewer"))
@@ -967,7 +1067,7 @@ chmod -R 777 /opt/keys"))
(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? "")))))
,@(if (or (member 'nextcloud selected-apps) (member 'ghost selected-apps))
,@(if (or (member 'nextcloud selected-apps) (member 'ghost selected-apps) (member 'nassella selected-apps))
`((Fieldset
(@ (title "All Apps - Email - SMTP"))
(Field (@ (name "smtp-host") (label ("Host"))
@@ -1009,7 +1109,30 @@ chmod -R 777 /opt/keys"))
(redis-password . ,(or (alist-ref 'redis-password
(alist-ref 'nextcloud config eq? '()))
(generate-redis-password)))))
(nassella . ((subdomain . ,(alist-ref 'nassella-subdomain (current-params)))))
(nassella . ((subdomain . ,(alist-ref 'nassella-subdomain (current-params)))
(postgres-password . ,(or (alist-ref 'postgres-password
(alist-ref 'nassella config eq? '()))
(generate-postgres-password)))
(authelia-postgres-password . ,(or (alist-ref 'authelia-postgres-password
(alist-ref 'nassella config eq? '()))
(generate-postgres-password)))
(lldap-postgres-password . ,(or (alist-ref 'lldap-postgres-password
(alist-ref 'nassella config eq? '()))
(generate-postgres-password)))
(lldap-jwt-secret . ,(or (alist-ref 'lldap-jwt-secret
(alist-ref 'nassella config eq? '()))
(generate-jwt-secret)))
(lldap-key-seed . ,(or (alist-ref 'lldap-key-seed
(alist-ref 'nassella config eq? '()))
(generate-key-seed)))
(lldap-subdomain . ,(alist-ref 'nassella-lldap-subdomain (current-params)))
(lldap-admin-password . ,(alist-ref 'nassella-lldap-admin-password (current-params)))
(authelia-jwt-secret . ,(or (alist-ref 'authelia-jwt-secret
(alist-ref 'nassella config eq? '()))
(generate-jwt-secret)))
(authelia-key-seed . ,(or (alist-ref 'authelia-key-seed
(alist-ref 'nassella config eq? '()))
(generate-authelia-key-seed)))))
(log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (current-params)))
(user . ,(alist-ref 'log-viewer-user (current-params)))
(password . ,(alist-ref 'log-viewer-password (current-params)))))
@@ -1117,7 +1240,8 @@ chmod -R 777 /opt/keys"))
(@ (step "Review"))
(h2 "Root Domain")
,root-domain
(h2 "Apps")
(h2 "Apps") ;; TODO if an app that was previously selected is now unselected we need to somehow delete its data
;; so that if the user then re-deploys the app later we don't have key conflicts
(ul ,@(map (lambda (app) `(li ,app " @ "
,(alist-ref 'subdomain (alist-ref app config))
"."
@@ -1182,6 +1306,21 @@ chmod -R 777 /opt/keys"))
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
("NASSELLA_POSTGRES_DB" . "nassella")
("NASSELLA_POSTGRES_USER" . "nassella")
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
@@ -1200,10 +1339,10 @@ chmod -R 777 /opt/keys"))
("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")
("cluster_name" . "nassella")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
("flatcar_stable_version" . "4459.2.3")))
("flatcar_stable_version" . "4459.2.4")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]"))))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1346,7 +1485,9 @@ chmod -R 777 /opt/keys"))
(li "Upgrade Now (pending automatic upgrades scheduled for: )")
(li "Manage Backups")
(li (a (@ (href "/destroy/" ,(alist-ref 'instance-id instance)))
"Destroy (confirmation required)")))))))
"Destroy - deletes data and configuration (confirmation required)"))
(li (a (@ (href "/reset/" ,(alist-ref 'instance-id instance)))
"Reset - deletes data (confirmation required)")))))))
(with-db/transaction
(lambda (db)
(get-dashboard db (session-user-id))))))))))
@@ -1361,7 +1502,7 @@ chmod -R 777 /opt/keys"))
`(App
(h2 "Destroy Instance")
,root-domain
(h2 "This action is NOT reversible")
(h2 "This action is NOT reversible. All data will be lost!")
(form
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
(VStack
@@ -1399,50 +1540,66 @@ chmod -R 777 /opt/keys"))
(begin
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
(with-output-to-file (string-append dir "/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" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
("SMTP_AUTH_PASSWORD" . ,(alist-ref 'smtp-auth-password (alist-ref 'all-apps config)))
("SMTP_FROM" . ,(alist-ref 'smtp-from (alist-ref 'all-apps config)))
("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" . ,restic-password)))))
(with-output-to-file (string-append dir "/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" . "4459.2.1")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
(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" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
("NASSELLA_POSTGRES_DB" . "nassella")
("NASSELLA_POSTGRES_USER" . "nassella")
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
("SMTP_AUTH_PASSWORD" . ,(alist-ref 'smtp-auth-password (alist-ref 'all-apps config)))
("SMTP_FROM" . ,(alist-ref 'smtp-from (alist-ref 'all-apps config)))
("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" . ,restic-password)))))
(with-output-to-file (string-append dir "/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" . "nassella")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
("flatcar_stable_version" . "4459.2.4")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
;; TODO need a new table to track destroying?
;; as this is creating a new "deployment"
;; to attach state to
@@ -1495,9 +1652,54 @@ chmod -R 777 /opt/keys"))
(with-input-from-file (string-append dir "/make-out") read-string))
(update-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup))))))))))))
(if (eof-object? tf-state-backup) "" tf-state-backup))
(when exit-normal
(destroy-instance db instance-id))))))))))))
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
(get/widgets
("/destroy-success/:id"
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(res (with-db/transaction
(lambda (db)
`((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id))))))
(status (or (and (alist-ref 'status res) (string->symbol (alist-ref 'status res))) 'destroyed)))
(if (or (eq? status 'complete) (eq? status 'failed) (eq? status 'destroyed))
'()
'((meta (@ (http-equiv "refresh") (content "5")))))))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(res (with-db/transaction
(lambda (db)
`((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id))
(progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id))))))
(output (with-input-from-file (string-append (deployment-directory (session-user-id)) "/make-out") read-string))
(progress (alist-ref 'progress res))
(status (alist-ref 'status res)))
`(App
(Main-Container
(VStack
(h1
,(case (string->symbol status)
((queued) "Destroy queued")
((in-progress) "Destroy in progress")
((destroyed) "Destroy complete!")
((failed) "Destroy failed")))
,@(if (eq? status 'destroyed)
'((a (@ (href "/dashboard")) "Dashboard"))
`((ul (li "generate configs: " ,(progress-status->text (alist-ref 'generate-configs progress)))
(li "custom flatcar image: " ,(progress-status->text (alist-ref 'custom-image progress)))
(li "machine create: " ,(progress-status->text (alist-ref 'machine-create progress)))
(li "cleanup previous machine: " ,(progress-status->text (alist-ref 'machine-destroy progress))))
(div
(a (@ (href "/dashboard")) "Dashboard")
,@(if (or (eq? (string->symbol status) 'complete) (eq? (string->symbol status) 'failed))
'()
" (deployment will continue in the background if you leave this page)"))
(hr)
(pre (@ (style ((overflow-x "scroll"))))
,output)))
)))))
(schematra-install)
))