Adding better support for undeployed instances.
This commit is contained in:
74
src/db.scm
74
src/db.scm
@@ -515,37 +515,51 @@ 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))))
|
||||
(map
|
||||
(lambda (instance)
|
||||
(cons `(apps . ,(alist-ref (alist-ref 'instance-id instance) instance-apps))
|
||||
instance))
|
||||
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 (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)
|
||||
(cons '(deployed . #t)
|
||||
(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))))
|
||||
(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)
|
||||
|
||||
444
src/nassella.scm
444
src/nassella.scm
@@ -1936,20 +1936,23 @@ chmod -R 777 /opt/keys")))
|
||||
|
||||
(get/widgets
|
||||
("/dashboard")
|
||||
`(App
|
||||
(Main-Container
|
||||
(VStack
|
||||
(@ (element main))
|
||||
(h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances")
|
||||
(form
|
||||
(@ (action "/config/wizard/create-instance")
|
||||
(method POST))
|
||||
(Button "Setup New Instance"))
|
||||
(ul (@ (style ((list-style "none")
|
||||
(padding-left "0"))))
|
||||
,@(map (lambda (instance)
|
||||
(let ((root-domain (alist-ref 'root-domain instance))
|
||||
(config (alist-ref 'config instance)))
|
||||
(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
|
||||
(@ (element main))
|
||||
(h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances")
|
||||
(form
|
||||
(@ (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)")
|
||||
@@ -1957,44 +1960,88 @@ chmod -R 777 /opt/keys")))
|
||||
(padding ,($ 'space.75))
|
||||
(margin-bottom ,($ 'space.100)))))
|
||||
(VStack
|
||||
(h2 ,root-domain)
|
||||
(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)))
|
||||
`((li (a (@ (href "#") (style ((color ,($ 'color.primary.background-contrast))))) ,app) ;; TODO documentation URL
|
||||
" (v" ,(alist-ref 'installed-version app-info) ") "
|
||||
(a (@ (href "https://"
|
||||
,(alist-ref 'subdomain (alist-ref app config))
|
||||
"." ,root-domain)
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
,(alist-ref 'subdomain (alist-ref app config))
|
||||
"." ,root-domain)))))
|
||||
(or (filter (lambda (app-info)
|
||||
(case (alist-ref 'app-name app-info)
|
||||
((instance-control lldap authelia) #f)
|
||||
(else #t)))
|
||||
(alist-ref 'apps instance))
|
||||
'())))
|
||||
(h3 "Actions")
|
||||
(h2 "Undeployed Instance"))
|
||||
(ul (li (a (@ (href "/config/wizard/services/"
|
||||
,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Modify Setup"))
|
||||
;; (li "Upgrade Now (pending automatic upgrades scheduled for: )")
|
||||
(li (a (@ (href "/backups/" ,(alist-ref 'instance-id instance))
|
||||
"Resume Setup"))
|
||||
(li (a (@ (href "/destroy-undeployed/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Manage Backups"))
|
||||
(li (a (@ (href "/destroy/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Destroy - deletes data and configuration (confirmation required)"))
|
||||
(li (a (@ (href "/reset/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Reset - deletes data (confirmation required)")))))))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(get-dashboard db (session-user-id))))))))))
|
||||
"Destroy - deletes data and configuration (confirmation required)"))))))
|
||||
not-deployed-instances))
|
||||
(ul (@ (style ((list-style "none")
|
||||
(padding-left "0"))))
|
||||
,@(map (lambda (instance)
|
||||
(let ((root-domain (alist-ref 'root-domain instance))
|
||||
(config (alist-ref 'config instance)))
|
||||
`(li
|
||||
(VStack
|
||||
(@ (style ((background "rgba(0,0,0,0.1)")
|
||||
(border-radius ,($ 'radius.medium))
|
||||
(padding ,($ 'space.75))
|
||||
(margin-bottom ,($ 'space.100)))))
|
||||
(VStack
|
||||
(h2 ,root-domain)
|
||||
,@(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)))
|
||||
`((li (a (@ (href "#") (style ((color ,($ 'color.primary.background-contrast))))) ,app) ;; TODO documentation URL
|
||||
" (v" ,(alist-ref 'installed-version app-info) ") "
|
||||
(a (@ (href "https://"
|
||||
,(alist-ref 'subdomain (alist-ref app config))
|
||||
"." ,root-domain)
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
,(alist-ref 'subdomain (alist-ref app config))
|
||||
"." ,root-domain)))))
|
||||
(or (filter (lambda (app-info)
|
||||
(case (alist-ref 'app-name app-info)
|
||||
((instance-control lldap authelia) #f)
|
||||
(else #t)))
|
||||
(alist-ref 'apps instance))
|
||||
'())))
|
||||
(h3 "Actions")
|
||||
(ul (li (a (@ (href "/config/wizard/services/"
|
||||
,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Modify Setup"))
|
||||
;; (li "Upgrade Now (pending automatic upgrades scheduled for: )")
|
||||
(li (a (@ (href "/backups/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Manage Backups"))
|
||||
(li (a (@ (href "/destroy/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Destroy - deletes data and configuration (confirmation required)"))
|
||||
(li (a (@ (href "/reset/" ,(alist-ref 'instance-id instance))
|
||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||
"Reset - deletes data (confirmation required)")))))))
|
||||
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)
|
||||
(destroy-instance db instance-id)))
|
||||
(redirect "/dashboard")))))
|
||||
|
||||
(get/widgets
|
||||
("/destroy/:id")
|
||||
@@ -2011,151 +2058,170 @@ chmod -R 777 /opt/keys")))
|
||||
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
|
||||
(VStack
|
||||
(Fieldset
|
||||
(@ (title "Type the domain name of the instance to confirm."))
|
||||
(Field (@ (name "instance-domain") (label ("Domain")) (value ""))))
|
||||
(@ (title "Type the domain name of the instance to confirm."))
|
||||
(Field (@ (name "instance-domain") (label ("Domain")) (value ""))))
|
||||
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
|
||||
|
||||
;; TODO This is mostly a copy of the deployment POST action
|
||||
(post "/destroy-submit/:id"
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(results
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
`((selected-apps . ,(map
|
||||
car
|
||||
(filter cdr
|
||||
(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)))
|
||||
(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))
|
||||
(terraform-state (alist-ref 'terraform-state results))
|
||||
(ssh-pub-key (alist-ref 'ssh-pub-key results))
|
||||
(restic-password (alist-ref 'restic-password results))
|
||||
(dir (deployment-directory (session-user-id) instance-id)))
|
||||
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
|
||||
(redirect (conc "/destroy/" instance-id))
|
||||
(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)))
|
||||
("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_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)))
|
||||
("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)
|
||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))))))
|
||||
(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" . "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?
|
||||
;; as this is creating a new "deployment"
|
||||
;; to attach state to
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(user-id (session-user-id))
|
||||
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
|
||||
(dir (deployment-directory user-id instance-id)))
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(change-directory dir)
|
||||
(let ((pid (process-run "make destroy > make-out 2>&1")))
|
||||
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
|
||||
(change-directory "../")
|
||||
(let loop ()
|
||||
(thread-sleep! 5)
|
||||
(receive (pid exit-normal status) (process-wait pid #t)
|
||||
(if (= pid 0) ;; process is still running
|
||||
(begin (let ((progress (parse-deployment-log
|
||||
(with-input-from-file
|
||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
||||
read-string)))
|
||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(when (file-exists? (string-append dir "/terraform.tfstate"))
|
||||
(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))))))
|
||||
(loop))
|
||||
(let ((progress (parse-deployment-log
|
||||
(with-input-from-file
|
||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
||||
read-string)))
|
||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(update-deployment-status
|
||||
db user-id deployment-id
|
||||
(if exit-normal 'complete 'failed)
|
||||
(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))
|
||||
(when exit-normal
|
||||
(destroy-instance db instance-id))))))))))))
|
||||
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(results
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
`((selected-apps . ,(map
|
||||
car
|
||||
(filter cdr
|
||||
(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 (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))
|
||||
(terraform-state (alist-ref 'terraform-state results))
|
||||
(ssh-pub-key (alist-ref 'ssh-pub-key results))
|
||||
(restic-password (alist-ref 'restic-password results))
|
||||
(dir (deployment-directory (session-user-id) instance-id)))
|
||||
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
|
||||
(redirect (conc "/destroy/" instance-id))
|
||||
(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-version)
|
||||
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
|
||||
","
|
||||
(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)))
|
||||
("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_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)))
|
||||
("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)
|
||||
("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-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" . ,(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")))
|
||||
;; 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
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(user-id (session-user-id))
|
||||
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
|
||||
(dir (deployment-directory user-id instance-id)))
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(change-directory dir)
|
||||
(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 ()
|
||||
(thread-sleep! 5)
|
||||
(receive (pid exit-normal status) (process-wait pid #t)
|
||||
(if (= pid 0) ;; process is still running
|
||||
(begin (let ((progress (parse-deployment-log
|
||||
(with-input-from-file
|
||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
||||
read-string)))
|
||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(when (file-exists? (string-append dir "/terraform.tfstate"))
|
||||
(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))))))
|
||||
(loop))
|
||||
(let ((progress (parse-deployment-log
|
||||
(with-input-from-file
|
||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
||||
read-string)))
|
||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(update-deployment-status
|
||||
db user-id deployment-id
|
||||
(if exit-normal 'complete 'failed)
|
||||
(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))
|
||||
(when exit-normal
|
||||
(destroy-instance db instance-id))))))))))))
|
||||
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
|
||||
|
||||
(get/widgets
|
||||
("/destroy-success/:id"
|
||||
|
||||
Reference in New Issue
Block a user