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
|
"select apps.app_name, usa.installed_version, usa.instance_id from user_selected_apps usa
|
||||||
join apps on apps.id=usa.app_id
|
join apps on apps.id=usa.app_id
|
||||||
where user_id=$1;"
|
where user_id=$1;"
|
||||||
user-id))))
|
user-id)))
|
||||||
(map
|
(undeployed-res
|
||||||
(lambda (instance)
|
(query conn
|
||||||
(cons `(apps . ,(alist-ref (alist-ref 'instance-id instance) instance-apps))
|
(string-append
|
||||||
instance))
|
"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
|
(map
|
||||||
(lambda (row-num)
|
(lambda (instance)
|
||||||
(map (lambda (item)
|
(cons `(apps . ,(alist-ref (alist-ref 'instance-id instance) instance-apps))
|
||||||
(let* ((key (car item))
|
instance))
|
||||||
(value (cdr item))
|
(map
|
||||||
(config (alist-ref key `((root_domain . root-domain)
|
(lambda (row-num)
|
||||||
(config_enc . config)
|
(cons '(deployed . #t)
|
||||||
(instance_id . instance-id)
|
(map (lambda (item)
|
||||||
;; (wg_easy_version . wg-easy)
|
(let* ((key (car item))
|
||||||
;; (nextcloud_version . nextcloud)
|
(value (cdr item))
|
||||||
;; (ghost_version . ghost)
|
(config (alist-ref key `((root_domain . root-domain)
|
||||||
;; (nassella_version . nassella)
|
(config_enc . config)
|
||||||
;; (log_viewer_version . log-viewer)
|
(instance_id . instance-id)
|
||||||
;; (instance_control_version . instance-control)
|
;; (wg_easy_version . wg-easy)
|
||||||
,@*deployments-reverse-column-map*))))
|
;; (nextcloud_version . nextcloud)
|
||||||
`(,config . ,(if (sql-null? value)
|
;; (ghost_version . ghost)
|
||||||
#f
|
;; (nassella_version . nassella)
|
||||||
(if (and (string? value) (member config *deployments-column-map*))
|
;; (log_viewer_version . log-viewer)
|
||||||
(string->symbol value)
|
;; (instance_control_version . instance-control)
|
||||||
(if (eq? key 'config_enc)
|
,@*deployments-reverse-column-map*))))
|
||||||
(with-input-from-string
|
`(,config . ,(if (sql-null? value)
|
||||||
(user-decrypt-from-db value user-key user-iv user-id)
|
#f
|
||||||
read)
|
(if (and (string? value) (member config *deployments-column-map*))
|
||||||
value))))))
|
(string->symbol value)
|
||||||
(row-alist res row-num)))
|
(if (eq? key 'config_enc)
|
||||||
(iota (row-count res)))))))
|
(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)
|
(define (update-user-terraform-state conn user-id instance-id state backup)
|
||||||
(receive (user-key user-iv auth-user-id)
|
(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
|
(get/widgets
|
||||||
("/dashboard")
|
("/dashboard")
|
||||||
`(App
|
(let* ((res (with-db/transaction
|
||||||
(Main-Container
|
(lambda (db)
|
||||||
(VStack
|
(get-dashboard db (session-user-id)))))
|
||||||
(@ (element main))
|
(deployed-instances (filter (lambda (x) (alist-ref 'deployed x)) res))
|
||||||
(h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances")
|
(not-deployed-instances (filter (lambda (x) (not (alist-ref 'deployed x))) res)))
|
||||||
(form
|
`(App
|
||||||
(@ (action "/config/wizard/create-instance")
|
(Main-Container
|
||||||
(method POST))
|
(VStack
|
||||||
(Button "Setup New Instance"))
|
(@ (element main))
|
||||||
(ul (@ (style ((list-style "none")
|
(h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances")
|
||||||
(padding-left "0"))))
|
(form
|
||||||
,@(map (lambda (instance)
|
(@ (action "/config/wizard/create-instance")
|
||||||
(let ((root-domain (alist-ref 'root-domain instance))
|
(method POST))
|
||||||
(config (alist-ref 'config instance)))
|
(Button "Setup New Instance"))
|
||||||
|
(ul (@ (style ((list-style "none")
|
||||||
|
(padding-left "0"))))
|
||||||
|
,@(map (lambda (instance)
|
||||||
`(li
|
`(li
|
||||||
(VStack
|
(VStack
|
||||||
(@ (style ((background "rgba(0,0,0,0.1)")
|
(@ (style ((background "rgba(0,0,0,0.1)")
|
||||||
@@ -1957,44 +1960,88 @@ chmod -R 777 /opt/keys")))
|
|||||||
(padding ,($ 'space.75))
|
(padding ,($ 'space.75))
|
||||||
(margin-bottom ,($ 'space.100)))))
|
(margin-bottom ,($ 'space.100)))))
|
||||||
(VStack
|
(VStack
|
||||||
(h2 ,root-domain)
|
(h2 "Undeployed 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/"
|
(ul (li (a (@ (href "/config/wizard/services/"
|
||||||
,(alist-ref 'instance-id instance))
|
,(alist-ref 'instance-id instance))
|
||||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||||
"Modify Setup"))
|
"Resume Setup"))
|
||||||
;; (li "Upgrade Now (pending automatic upgrades scheduled for: )")
|
(li (a (@ (href "/destroy-undeployed/" ,(alist-ref 'instance-id instance))
|
||||||
(li (a (@ (href "/backups/" ,(alist-ref 'instance-id instance))
|
|
||||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
(style ((color ,($ 'color.primary.background-contrast)))))
|
||||||
"Manage Backups"))
|
"Destroy - deletes data and configuration (confirmation required)"))))))
|
||||||
(li (a (@ (href "/destroy/" ,(alist-ref 'instance-id instance))
|
not-deployed-instances))
|
||||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
(ul (@ (style ((list-style "none")
|
||||||
"Destroy - deletes data and configuration (confirmation required)"))
|
(padding-left "0"))))
|
||||||
(li (a (@ (href "/reset/" ,(alist-ref 'instance-id instance))
|
,@(map (lambda (instance)
|
||||||
(style ((color ,($ 'color.primary.background-contrast)))))
|
(let ((root-domain (alist-ref 'root-domain instance))
|
||||||
"Reset - deletes data (confirmation required)")))))))
|
(config (alist-ref 'config instance)))
|
||||||
(with-db/transaction
|
`(li
|
||||||
(lambda (db)
|
(VStack
|
||||||
(get-dashboard db (session-user-id))))))))))
|
(@ (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
|
(get/widgets
|
||||||
("/destroy/:id")
|
("/destroy/:id")
|
||||||
@@ -2011,151 +2058,170 @@ chmod -R 777 /opt/keys")))
|
|||||||
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
|
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
|
||||||
(VStack
|
(VStack
|
||||||
(Fieldset
|
(Fieldset
|
||||||
(@ (title "Type the domain name of the instance to confirm."))
|
(@ (title "Type the domain name of the instance to confirm."))
|
||||||
(Field (@ (name "instance-domain") (label ("Domain")) (value ""))))
|
(Field (@ (name "instance-domain") (label ("Domain")) (value ""))))
|
||||||
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
|
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
|
||||||
|
|
||||||
;; TODO This is mostly a copy of the deployment POST action
|
;; TODO This is mostly a copy of the deployment POST action
|
||||||
(post "/destroy-submit/:id"
|
(post "/destroy-submit/:id"
|
||||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||||
(results
|
(results
|
||||||
(with-db/transaction
|
(with-db/transaction
|
||||||
(lambda (db)
|
(lambda (db)
|
||||||
`((selected-apps . ,(map
|
`((selected-apps . ,(map
|
||||||
car
|
car
|
||||||
(filter cdr
|
(filter cdr
|
||||||
(get-user-selected-apps db (session-user-id) instance-id))))
|
(get-user-selected-apps db (session-user-id) instance-id))))
|
||||||
(app-config . ,(get-user-app-config 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))
|
(service-config . ,(get-user-service-config db (session-user-id) instance-id))
|
||||||
(terraform-state . ,(get-user-terraform-state 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))
|
(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))))))
|
(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))
|
(app-config (alist-ref 'app-config results))
|
||||||
(config (alist-ref 'config app-config))
|
(config (alist-ref 'config app-config))
|
||||||
(root-domain (alist-ref 'root-domain app-config))
|
(root-domain (alist-ref 'root-domain app-config))
|
||||||
(service-config (alist-ref 'service-config results))
|
(service-config (alist-ref 'service-config results))
|
||||||
(terraform-state (alist-ref 'terraform-state results))
|
(terraform-state (alist-ref 'terraform-state results))
|
||||||
(ssh-pub-key (alist-ref 'ssh-pub-key results))
|
(ssh-pub-key (alist-ref 'ssh-pub-key results))
|
||||||
(restic-password (alist-ref 'restic-password results))
|
(restic-password (alist-ref 'restic-password results))
|
||||||
(dir (deployment-directory (session-user-id) instance-id)))
|
(dir (deployment-directory (session-user-id) instance-id)))
|
||||||
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
|
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
|
||||||
(redirect (conc "/destroy/" instance-id))
|
(redirect (conc "/destroy/" instance-id))
|
||||||
(begin
|
(begin
|
||||||
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
|
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
|
||||||
(with-output-to-file (string-append dir "/config/apps.config")
|
(with-output-to-file (string-append dir "/config/apps.config")
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(map (lambda (e)
|
(map (lambda (e)
|
||||||
(write-config-entry (car e) (cdr e)))
|
(write-config-entry (car e) (cdr e)))
|
||||||
`(("ROOT_DOMAIN" . ,root-domain)
|
`(("ROOT_DOMAIN" . ,root-domain)
|
||||||
("APP_CONFIGS" . ,(string-intersperse
|
("APP_CONFIGS" . ,(string-intersperse
|
||||||
(map (lambda (app)
|
(map (lambda (app-version)
|
||||||
(conc (if (eq? app 'log-viewer) 'dozzle app)
|
(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))
|
||||||
selected-apps)
|
","
|
||||||
" "))
|
(cdr app-version)))
|
||||||
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
|
selected-apps)
|
||||||
("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config)))
|
" "))
|
||||||
("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
|
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
|
||||||
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
|
("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config)))
|
||||||
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
|
("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
|
||||||
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
|
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
|
||||||
("NEXTCLOUD_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
|
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
|
||||||
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
|
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
|
||||||
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
|
("NEXTCLOUD_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
|
||||||
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
|
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
|
||||||
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
|
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
|
||||||
("NASSELLA_POSTGRES_DB" . "nassella")
|
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
|
||||||
("NASSELLA_POSTGRES_USER" . "nassella")
|
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
|
||||||
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
|
("NASSELLA_POSTGRES_DB" . "nassella")
|
||||||
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
|
("NASSELLA_POSTGRES_USER" . "nassella")
|
||||||
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
|
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
|
||||||
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
|
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
|
||||||
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
|
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
|
||||||
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
|
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
|
||||||
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
|
||||||
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
|
||||||
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
|
||||||
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
|
||||||
("NASSELLA_STRIPE_API_KEY" . ,(alist-ref 'stripe-api-key (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
|
||||||
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
|
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
|
||||||
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
|
("NASSELLA_STRIPE_API_KEY" . ,(alist-ref 'stripe-api-key (alist-ref 'nassella config)))
|
||||||
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
|
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
|
||||||
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
|
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
|
||||||
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
|
("WORDPRESS_DB_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'wordpress config)))
|
||||||
("SMTP_AUTH_PASSWORD" . ,(alist-ref 'smtp-auth-password (alist-ref 'all-apps config)))
|
("WORDPRESS_DB_ROOT_PASSWORD" . ,(alist-ref 'db-root-password (alist-ref 'wordpress config)))
|
||||||
("SMTP_FROM" . ,(alist-ref 'smtp-from (alist-ref 'all-apps config)))
|
("LLDAP_POSTGRES_DB" . "lldap")
|
||||||
("BACKBLAZE_KEY_ID" . ,(alist-ref 'backblaze-key-id service-config))
|
("LLDAP_POSTGRES_USER" . "lldap")
|
||||||
("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
|
("LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'lldap config)))
|
||||||
("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
|
("LLDAP_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'lldap config)))
|
||||||
("RESTIC_PASSWORD" . ,restic-password)
|
("LLDAP_KEY_SEED" . ,(alist-ref 'key-seed (alist-ref 'lldap config)))
|
||||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))))))
|
("LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'lldap config)))
|
||||||
(with-output-to-file (string-append dir "/config/production.tfvars")
|
("LLDAP_USER_EMAIL" . ,(alist-ref 'user-email (alist-ref 'lldap config)))
|
||||||
(lambda ()
|
("AUTHELIA_POSTGRES_DB" . "authelia")
|
||||||
(map (lambda (e)
|
("AUTHELIA_POSTGRES_USER" . "authelia")
|
||||||
(write-config-entry (car e) (cdr e)))
|
("AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'authelia config)))
|
||||||
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
|
("AUTHELIA_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'authelia config)))
|
||||||
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
|
("AUTHELIA_SESSION_SECRET" . ,(alist-ref 'session-secret (alist-ref 'authelia config)))
|
||||||
("cloudflare_api_token" . ,(alist-ref 'cloudflare-api-token service-config))
|
("AUTHELIA_ENCRYPTION_KEY" . ,(alist-ref 'encryption-key (alist-ref 'authelia config)))
|
||||||
("cloudflare_zone_id" . ,(alist-ref 'cloudflare-zone-id service-config))
|
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
|
||||||
("cloudflare_account_id" . ,(alist-ref 'cloudflare-account-id service-config))
|
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
|
||||||
("cluster_name" . "nassella")
|
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
|
||||||
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
|
("SMTP_AUTH_PASSWORD" . ,(alist-ref 'smtp-auth-password (alist-ref 'all-apps config)))
|
||||||
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
|
("SMTP_FROM" . ,(alist-ref 'smtp-from (alist-ref 'all-apps config)))
|
||||||
("Flatcar_stable_version" . "4593.2.4")))
|
("BACKBLAZE_KEY_ID" . ,(alist-ref 'backblaze-key-id service-config))
|
||||||
;; remove the newline that generating the ssh key adds
|
("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
|
||||||
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
|
("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
|
||||||
;; TODO need a new table to track destroying?
|
("RESTIC_PASSWORD" . ,restic-password)
|
||||||
;; as this is creating a new "deployment"
|
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))
|
||||||
;; to attach state to
|
,@(if (and restic-snapshot-id (not (string=? restic-snapshot-id ""))) `(("RESTIC_SNAPSHOT_ID" . ,restic-snapshot-id)) '())))))
|
||||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
(with-output-to-file (string-append dir "/config/production.tfvars")
|
||||||
(user-id (session-user-id))
|
(lambda ()
|
||||||
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
|
(map (lambda (e)
|
||||||
(dir (deployment-directory user-id instance-id)))
|
(write-terraform-config-entry (car e) (cdr e)))
|
||||||
(thread-start!
|
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
|
||||||
(lambda ()
|
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
|
||||||
(change-directory dir)
|
("digitalocean_volume_size" . ,(alist-ref 'digitalocean-volume-size service-config))
|
||||||
(let ((pid (process-run "make destroy > make-out 2>&1")))
|
("cloudflare_api_token" . ,(alist-ref 'cloudflare-api-token service-config))
|
||||||
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
|
("cloudflare_zone_id" . ,(alist-ref 'cloudflare-zone-id service-config))
|
||||||
(change-directory "../")
|
("cloudflare_account_id" . ,(alist-ref 'cloudflare-account-id service-config))
|
||||||
(let loop ()
|
("cluster_name" . ,(string-append "nassella" (string-delete #\. root-domain))) ;; TODO update to: (import srfi-14) (string-filter char-set:letter+digit root-domain)
|
||||||
(thread-sleep! 5)
|
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
|
||||||
(receive (pid exit-normal status) (process-wait pid #t)
|
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
|
||||||
(if (= pid 0) ;; process is still running
|
("flatcar_stable_version" . "4593.2.4")))
|
||||||
(begin (let ((progress (parse-deployment-log
|
;; remove the newline that generating the ssh key adds
|
||||||
(with-input-from-file
|
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
|
||||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
;; TODO need a new table to track destroying?
|
||||||
read-string)))
|
;; as this is creating a new "deployment"
|
||||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
;; to attach state to
|
||||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||||
(with-db/transaction
|
(user-id (session-user-id))
|
||||||
(lambda (db)
|
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
|
||||||
(update-deployment-progress db deployment-id progress)
|
(dir (deployment-directory user-id instance-id)))
|
||||||
(when (file-exists? (string-append dir "/terraform.tfstate"))
|
(thread-start!
|
||||||
(update-user-terraform-state db user-id instance-id
|
(lambda ()
|
||||||
(if (eof-object? tf-state) "" tf-state)
|
(change-directory dir)
|
||||||
(if (eof-object? tf-state-backup) "" tf-state-backup))))))
|
(let ((pid (process-run "make preapply && make destroy > make-out 2>&1")))
|
||||||
(loop))
|
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
|
||||||
(let ((progress (parse-deployment-log
|
(change-directory "../")
|
||||||
(with-input-from-file
|
(let loop ()
|
||||||
(string-append (deployment-directory user-id instance-id) "/make-out")
|
(thread-sleep! 5)
|
||||||
read-string)))
|
(receive (pid exit-normal status) (process-wait pid #t)
|
||||||
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
(if (= pid 0) ;; process is still running
|
||||||
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
(begin (let ((progress (parse-deployment-log
|
||||||
(with-db/transaction
|
(with-input-from-file
|
||||||
(lambda (db)
|
(string-append (deployment-directory user-id instance-id) "/make-out")
|
||||||
(update-deployment-progress db deployment-id progress)
|
read-string)))
|
||||||
(update-deployment-status
|
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
|
||||||
db user-id deployment-id
|
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
|
||||||
(if exit-normal 'complete 'failed)
|
(with-db/transaction
|
||||||
(with-input-from-file (string-append dir "/make-out") read-string))
|
(lambda (db)
|
||||||
(update-user-terraform-state db user-id instance-id
|
(update-deployment-progress db deployment-id progress)
|
||||||
(if (eof-object? tf-state) "" tf-state)
|
(when (file-exists? (string-append dir "/terraform.tfstate"))
|
||||||
(if (eof-object? tf-state-backup) "" tf-state-backup))
|
(update-user-terraform-state db user-id instance-id
|
||||||
(when exit-normal
|
(if (eof-object? tf-state) "" tf-state)
|
||||||
(destroy-instance db instance-id))))))))))))
|
(if (eof-object? tf-state-backup) "" tf-state-backup))))))
|
||||||
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
|
(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
|
(get/widgets
|
||||||
("/destroy-success/:id"
|
("/destroy-success/:id"
|
||||||
|
|||||||
Reference in New Issue
Block a user