Adding better support for undeployed instances.
This commit is contained in:
20
src/db.scm
20
src/db.scm
@@ -515,13 +515,23 @@ where usa.user_id=$1 and usa.instance_id=$2;"
|
||||
"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))))
|
||||
user-id)))
|
||||
(undeployed-res
|
||||
(query conn
|
||||
(string-append
|
||||
"select i.instance_id from instances as i "
|
||||
"left join deployments d on d.instance_id = i.instance_id "
|
||||
"where i.user_id=$1 and d.status is null "
|
||||
"group by d.id, i.instance_id;")
|
||||
user-id)))
|
||||
(append
|
||||
(map
|
||||
(lambda (instance)
|
||||
(cons `(apps . ,(alist-ref (alist-ref 'instance-id instance) instance-apps))
|
||||
instance))
|
||||
(map
|
||||
(lambda (row-num)
|
||||
(cons '(deployed . #t)
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
@@ -544,8 +554,12 @@ where user_id=$1;"
|
||||
(user-decrypt-from-db value user-key user-iv user-id)
|
||||
read)
|
||||
value))))))
|
||||
(row-alist res row-num)))
|
||||
(iota (row-count res)))))))
|
||||
(row-alist res row-num))))
|
||||
(iota (row-count res))))
|
||||
(map (lambda (id) `((instance-id . ,id) (deployed . #f)))
|
||||
(if (> (row-count undeployed-res) 0)
|
||||
(row-values undeployed-res)
|
||||
'()))))))
|
||||
|
||||
(define (update-user-terraform-state conn user-id instance-id state backup)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
|
||||
@@ -1936,6 +1936,11 @@ chmod -R 777 /opt/keys")))
|
||||
|
||||
(get/widgets
|
||||
("/dashboard")
|
||||
(let* ((res (with-db/transaction
|
||||
(lambda (db)
|
||||
(get-dashboard db (session-user-id)))))
|
||||
(deployed-instances (filter (lambda (x) (alist-ref 'deployed x)) res))
|
||||
(not-deployed-instances (filter (lambda (x) (not (alist-ref 'deployed x))) res)))
|
||||
`(App
|
||||
(Main-Container
|
||||
(VStack
|
||||
@@ -1945,6 +1950,25 @@ chmod -R 777 /opt/keys")))
|
||||
(@ (action "/config/wizard/create-instance")
|
||||
(method POST))
|
||||
(Button "Setup New Instance"))
|
||||
(ul (@ (style ((list-style "none")
|
||||
(padding-left "0"))))
|
||||
,@(map (lambda (instance)
|
||||
`(li
|
||||
(VStack
|
||||
(@ (style ((background "rgba(0,0,0,0.1)")
|
||||
(border-radius ,($ 'radius.medium))
|
||||
(padding ,($ 'space.75))
|
||||
(margin-bottom ,($ 'space.100)))))
|
||||
(VStack
|
||||
(h2 "Undeployed Instance"))
|
||||
(ul (li (a (@ (href "/config/wizard/services/"
|
||||
,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Resume Setup"))
|
||||
(li (a (@ (href "/destroy-undeployed/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Destroy - deletes data and configuration (confirmation required)"))))))
|
||||
not-deployed-instances))
|
||||
(ul (@ (style ((list-style "none")
|
||||
(padding-left "0"))))
|
||||
,@(map (lambda (instance)
|
||||
@@ -1958,8 +1982,10 @@ chmod -R 777 /opt/keys")))
|
||||
(margin-bottom ,($ 'space.100)))))
|
||||
(VStack
|
||||
(h2 ,root-domain)
|
||||
(Status-Pill (@ (type ,(instance-status->pill-type (alist-ref 'status instance))))
|
||||
,@(if (alist-ref 'status instance)
|
||||
`((Status-Pill (@ (type ,(instance-status->pill-type (alist-ref 'status instance))))
|
||||
,(instance-status->display (alist-ref 'status instance))))
|
||||
'()))
|
||||
(h3 "Apps")
|
||||
(ul ,@(map (lambda (app-info)
|
||||
(let ((app (alist-ref 'app-name app-info)))
|
||||
@@ -1992,9 +2018,30 @@ chmod -R 777 /opt/keys")))
|
||||
(li (a (@ (href "/reset/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Reset - deletes data (confirmation required)")))))))
|
||||
(with-db/transaction
|
||||
deployed-instances)))))))
|
||||
|
||||
(get/widgets
|
||||
("/destroy-undeployed/:id")
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?)))
|
||||
`(App
|
||||
(h2 "Destroy Undeployed Instance")
|
||||
(h3 "This action is NOT reversible.")
|
||||
(form
|
||||
(@ (action ,(conc "/destroy-undeployed-submit/" instance-id)) (method POST))
|
||||
(VStack
|
||||
(Fieldset
|
||||
(@ (title "Type the word 'DELETE' to confirm."))
|
||||
(Field (@ (name "confirm") (label ("Type DELETE")) (value ""))))
|
||||
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
|
||||
|
||||
(post "/destroy-undeployed-submit/:id"
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?)))
|
||||
(if (not (string=? (alist-ref 'confirm (current-params)) "DELETE"))
|
||||
(redirect (conc "/destroy-undeployed/" instance-id))
|
||||
(begin (with-db/transaction
|
||||
(lambda (db)
|
||||
(get-dashboard db (session-user-id))))))))))
|
||||
(destroy-instance db instance-id)))
|
||||
(redirect "/dashboard")))))
|
||||
|
||||
(get/widgets
|
||||
("/destroy/:id")
|
||||
@@ -2030,7 +2077,7 @@ chmod -R 777 /opt/keys")))
|
||||
(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))
|
||||
@@ -2049,10 +2096,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))
|
||||
","
|
||||
(cdr app-version)))
|
||||
selected-apps)
|
||||
" "))
|
||||
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
|
||||
@@ -2081,6 +2130,21 @@ chmod -R 777 /opt/keys")))
|
||||
("NASSELLA_STRIPE_API_KEY" . ,(alist-ref 'stripe-api-key (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)))
|
||||
("WORDPRESS_DB_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'wordpress config)))
|
||||
("WORDPRESS_DB_ROOT_PASSWORD" . ,(alist-ref 'db-root-password (alist-ref 'wordpress config)))
|
||||
("LLDAP_POSTGRES_DB" . "lldap")
|
||||
("LLDAP_POSTGRES_USER" . "lldap")
|
||||
("LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'lldap config)))
|
||||
("LLDAP_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'lldap config)))
|
||||
("LLDAP_KEY_SEED" . ,(alist-ref 'key-seed (alist-ref 'lldap config)))
|
||||
("LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'lldap config)))
|
||||
("LLDAP_USER_EMAIL" . ,(alist-ref 'user-email (alist-ref 'lldap config)))
|
||||
("AUTHELIA_POSTGRES_DB" . "authelia")
|
||||
("AUTHELIA_POSTGRES_USER" . "authelia")
|
||||
("AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'authelia config)))
|
||||
("AUTHELIA_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_SESSION_SECRET" . ,(alist-ref 'session-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_ENCRYPTION_KEY" . ,(alist-ref 'encryption-key (alist-ref 'authelia 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)))
|
||||
@@ -2090,20 +2154,22 @@ chmod -R 777 /opt/keys")))
|
||||
("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
|
||||
("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
|
||||
("RESTIC_PASSWORD" . ,restic-password)
|
||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))))))
|
||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))
|
||||
,@(if (and restic-snapshot-id (not (string=? restic-snapshot-id ""))) `(("RESTIC_SNAPSHOT_ID" . ,restic-snapshot-id)) '())))))
|
||||
(with-output-to-file (string-append dir "/config/production.tfvars")
|
||||
(lambda ()
|
||||
(map (lambda (e)
|
||||
(write-config-entry (car e) (cdr e)))
|
||||
(write-terraform-config-entry (car e) (cdr e)))
|
||||
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
|
||||
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
|
||||
("digitalocean_volume_size" . ,(alist-ref 'digitalocean-volume-size 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")
|
||||
("cluster_name" . ,(string-append "nassella" (string-delete #\. root-domain))) ;; TODO update to: (import srfi-14) (string-filter char-set:letter+digit root-domain)
|
||||
("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" . "4593.2.4")))
|
||||
("flatcar_stable_version" . "4593.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?
|
||||
@@ -2116,7 +2182,7 @@ chmod -R 777 /opt/keys")))
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(change-directory dir)
|
||||
(let ((pid (process-run "make destroy > make-out 2>&1")))
|
||||
(let ((pid (process-run "make preapply && make destroy > make-out 2>&1")))
|
||||
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
|
||||
(change-directory "../")
|
||||
(let loop ()
|
||||
|
||||
Reference in New Issue
Block a user