Backblaze, db bugfixes and connection testing.

cl.yaml

@@ -31,7 +31,7 @@ systemd:
         [Service]
         Type=oneshot
         EnvironmentFile=/restic-env
-        ExecStart=/usr/bin/bash -c "docker run --rm --volume /nassella:/nassella --volume /restic-password:/restic-password -e AWS_ACCESS_KEY_ID=${AWS_ACCESS_KEY_ID} -e AWS_SECRET_ACCESS_KEY=${AWS_SECRET_ACCESS_KEY} -i restic/restic:0.18.0 backup --verbose --repo s3:s3.us-west-004.backblazeb2.com/nassella-test-bucket --password-file /restic-password /nassella"
+        ExecStart=/usr/bin/bash -c "docker run --rm --volume /nassella:/nassella --volume /restic-password:/restic-password -e AWS_ACCESS_KEY_ID=${AWS_ACCESS_KEY_ID} -e AWS_SECRET_ACCESS_KEY=${AWS_SECRET_ACCESS_KEY} -i restic/restic:0.18.0 backup --verbose --repo s3:${BACKBLAZE_BUCKET_URL} --password-file /restic-password /nassella"
         ExecStopPost=systemctl start app.service
 
     - name: restic-backup.timer

main.tf

@@ -137,6 +137,7 @@ resource "digitalocean_droplet" "machine" {
   size      = var.server_type
   ssh_keys  = [digitalocean_ssh_key.first.fingerprint]
   user_data = file("ignition.json")
+  graceful_shutdown = true
   lifecycle {
     create_before_destroy = true
   }

make-restic-generated.sh

@@ -6,3 +6,4 @@ set -e
 
 echo "AWS_ACCESS_KEY_ID=\"$BACKBLAZE_KEY_ID\""
 echo "AWS_SECRET_ACCESS_KEY=\"$BACKBLAZE_APPLICATION_KEY\""
+echo "BACKBLAZE_BUCKET_URL=\"$BACKBLAZE_BUCKET_URL\""

src/db-init.sql

@@ -10,7 +10,10 @@ create unique index users_auth_user_id_idx on users (auth_user_id);
 
 create table instances(
        instance_id bigserial primary key,
-       user_id integer not null references users on delete cascade
+       user_id integer not null references users on delete cascade,
+       ssh_key_priv_enc text,
+       ssh_key_pub_enc text,
+       restic_password_enc varchar(255)
 );
 create unique index instances_user_id_instance_id_idx on instances (instance_id, user_id);
 

src/db.scm

@@ -7,6 +7,9 @@
 
      create-user delete-user
      create-instance get-user-instances
+     get-instance-ssh-pub-key get-instance-ssh-priv-key
+     update-instance-ssh-pub-key
+     get-instance-restic-password
      update-user-service-config get-user-service-config
      update-user-selected-apps get-user-selected-apps
      update-user-app-config get-user-app-config
@@ -18,7 +21,7 @@
      update-deployment-progress get-deployment-progress
      get-most-recent-deployment-progress
      update-user-terraform-state get-user-terraform-state
-     get-user-deployments
+     get-dashboard
      )
 
 (import scheme
@@ -106,7 +109,7 @@
     (values (hexstring->blob user-key) (hexstring->blob user-iv) auth-user-id)))
 
 (define (user-encrypt message user-key user-iv user-id)
-  (encrypt message user-key user-iv (string->blob (number->string user-id))))
+  (encrypt message user-key user-iv (string->blob (->string user-id))))
 
 (define (user-encrypt-for-db message user-key user-iv user-id)
   (receive (message tag)
@@ -115,7 +118,7 @@
                    (blob->hexstring/uppercase (string->blob tag)))))
 
 (define (user-decrypt message tag user-key user-iv user-id)
-  (decrypt message tag user-key user-iv (string->blob (number->string user-id))))
+  (decrypt message tag user-key user-iv (string->blob (->string user-id))))
 
 (define (user-decrypt-from-db message-and-tag user-key user-iv user-id)
   (let ((raw-message (hexstring->blob (string-drop-right message-and-tag (* tag-length 2))))
@@ -141,16 +144,57 @@ returning users.user_id;"
 (define (delete-user conn user-id)
   (query conn "delete from users where user_id=$1;" user-id))
 
-(define (create-instance conn user-id)
+;; We also encrypt the ssh pub key not to hide it but to make it
+;; more difficult for someone to tamper with it which could allow
+;; an attacker to poison an instance with an ssh key that they have
+;; access to
+(define (create-instance conn user-id ssh-key-priv ssh-key-pub restic-password)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
     (let ((instance-id
            (value-at
             (query conn
-                 "insert into instances(user_id) values ($1) returning instances.instance_id;" user-id))))
+                   "insert into instances(user_id, ssh_key_priv_enc, ssh_key_pub_enc, restic_password_enc) values ($1, $2, $3, $4) returning instances.instance_id;"
+                   user-id
+                   (user-encrypt-for-db ssh-key-priv user-key user-iv user-id)
+                   (user-encrypt-for-db ssh-key-pub user-key user-iv user-id)
+                   (user-encrypt-for-db restic-password user-key user-iv user-id)))))
       (query conn "insert into user_service_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
       (query conn "insert into user_selected_apps(user_id, instance_id) values ($1, $2);" user-id instance-id)
       (query conn "insert into user_app_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
       (query conn "insert into user_terraform_state(user_id, instance_id) values ($1, $2);" user-id instance-id)
-    instance-id))
+      instance-id)))
+
+(define (get-instance-ssh-priv-key conn user-id instance-id)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (user-decrypt-from-db
+     (value-at (query conn "select ssh_key_priv_enc from instances where user_id=$1 and instance_id=$2;"
+                      user-id instance-id))
+     user-key user-iv user-id)))
+
+(define (get-instance-ssh-pub-key conn user-id instance-id)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (user-decrypt-from-db
+     (value-at (query conn "select ssh_key_pub_enc from instances where user_id=$1 and instance_id=$2;"
+                      user-id instance-id))
+     user-key user-iv user-id)))
+
+(define (update-instance-ssh-pub-key conn user-id instance-id ssh-pub-key)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (query conn "update instances set ssh_key_pub_enc=$3 where user_id=$1 and instance_id=$2;"
+           user-id instance-id
+           (user-encrypt-for-db ssh-pub-key user-key user-iv user-id))))
+
+(define (get-instance-restic-password conn user-id instance-id)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (user-decrypt-from-db
+     (value-at (query conn "select restic_password_enc from instances where user_id=$1 and instance_id=$2;"
+                      user-id instance-id))
+     user-key user-iv user-id)))
 
 (define (get-user-instances conn user-id)
   (column-values (query conn "select instance_id from instances where user_id=$1;" user-id)))
@@ -411,34 +455,50 @@ returning users.user_id;"
                                         value)))))
          res)))
 
-(define (get-user-deployments conn user-id)
+(define (get-dashboard conn user-id)
-  (let* ((res-raw
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (let ((res
            (query conn
                   (string-append
                    "select "
                    (string-intersperse
                     (map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
                     ", ")
-                  ", uac.root_domain"
+                   ", uac.root_domain, uac.config_enc, uac.instance_id, "
-                  " from deployments as d "
+                   "usa.wg_easy_version, usa.nextcloud_version, usa.log_viewer_version, usa.ghost_version "
+                   "from instances as i "
+                   "join (select instance_id, max(id) as id from deployments group by instance_id) d2 "
+                   "on d2.instance_id = i.instance_id "
+                   "join deployments d on d.id = d2.id "
                    "join user_app_configs uac on uac.user_id = d.user_id and uac.instance_id = d.instance_id "
-                  " where d.user_id=$1 order by d.id DESC limit 1;")
+                   "join user_selected_apps usa on usa.instance_id = uac.instance_id "
-                 user-id))
+                   "where i.user_id=$1;")
-         (res (if (> (row-count res-raw) 0) (row-alist res-raw) '())))
+                  user-id)))
-    (if (null? res)
+      (map
-        '()
+       (lambda (row-num)
-        ;; I think this is just a hack as currently we only return 1 deployment
-        (list
          (map (lambda (item)
                 (let* ((key (car item))
                        (value (cdr item))
-                       (config (alist-ref key (cons '(root_domain . root-domain) *deployments-reverse-column-map*))))
+                       (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)
+                                                (log_viewer_version . log-viewer)
+                                                ,@*deployments-reverse-column-map*))))
                   `(,config . ,(if (sql-null? value)
                                    #f
-                                   (if (string? value)
+                                   (if (and (string? value) (member config *deployments-column-map*))
                                        (string->symbol value)
-                                       value)))))
+                                       (if (eq? key 'config_enc)
-              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))))))
 
 (define (update-user-terraform-state conn user-id instance-id state backup)
   (receive (user-key user-iv auth-user-id)
@@ -456,10 +516,12 @@ returning users.user_id;"
     (let ((res (row-alist (query conn
                                  "select state_enc, state_backup_enc from user_terraform_state where user_id=$1 and instance_id=$2;"
                                  user-id instance-id))))
-      `((state . ,(if (sql-null? (alist-ref 'config_enc res))
+      `((state . ,(if (or (sql-null? (alist-ref 'config_enc res))
+                          (sql-null? (alist-ref 'state_enc res)))
                        ""
                        (user-decrypt-from-db (alist-ref 'state_enc res) user-key user-iv user-id)))
-        (backup . ,(if (sql-null? (alist-ref 'config_enc res))
+        (backup . ,(if (or (sql-null? (alist-ref 'config_enc res))
+                           (sql-null? (alist-ref 'state_backup_enc res)))
                        ""
                        (user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
 

src/nassella.scm

@@ -9,9 +9,13 @@
         (chicken process-context)
         (chicken irregex)
         (chicken file)
+        (chicken condition)
 
         (rename srfi-1 (delete srfi1:delete))
+        srfi-13
         srfi-18
+        srfi-158
+        srfi-194
 
         html-widgets
         sxml-transforms
@@ -23,7 +27,8 @@
         medea
         intarweb
         nassella-db
-        sql-null)
+        sql-null
+        openssl)
 
 (define app (schematra/make-app))
 
@@ -295,11 +300,16 @@ h1, h2, h3, h4, h5, h6 {
 (define-syntax get/widgets
   (syntax-rules ()
     ((_ (path) body ...)
+     (get/widgets (path '()) body ...))
+    ((_ (path headers) body ...)
      (get path
           (with-output-to-string
             (lambda ()
               (widget-sxml->html
-               '((meta (@ (name "viewport") (content "width=device-width"))))
+               (cons
+                '(meta (@ (name "viewport") (content "width=device-width")))
+                headers)
+               ;; `((meta (@ (name "viewport") (content "width=device-width"))))
                (begin
                  ;; TODO remove once sessions are integrated
                  (session-set! "user-id" (test-user-id))
@@ -470,16 +480,23 @@ h1, h2, h3, h4, h5, h6 {
       ,(if (equal? type "checkbox") input label)
       ,(if (equal? type "checkbox") label input))))
 
-(define-widget (Button ((type "submit")) contents)
+(define-widget (Button ((type "submit") (enabled #t)) contents)
   `(button (@ (type ,type)
-              (style ((background ,($ 'color.primary))
+              ,@(if enabled '() '((disabled)))
-                      (color ,($ 'color.primary.contrast))
+              (style ((background ,(if enabled
+                                       ($ 'color.primary)
+                                       ($ 'color.primary.contrast)))
+                      (color ,(if enabled
+                                  ($ 'color.primary.contrast)
+                                  ($ 'color.primary)))
                       (border-radius ,($ 'radius.medium))
                       (border-color ,($ 'color.primary.shade))
-                      (cursor "pointer"))))
+                      ,@(if enabled
+                            '((cursor "pointer"))
+                            '()))))
            ,@contents))
 
-(define-widget (Form-Nav ((back-to #f) (submit-button "Next")))
+(define-widget (Form-Nav ((back-to #f) (submit-button "Next") (submit-enabled #t)))
   `(HStack
     (@ (style ((justify-content "space-between"))))
     (a (@ (href ,(or back-to ""))
@@ -496,7 +513,7 @@ h1, h2, h3, h4, h5, h6 {
                         '()
                         '((pointer-events "none"))))))
        "Back")
-    (Button ,submit-button)))
+    (Button (@ (enabled ,submit-enabled)) ,submit-button)))
 
 ;; Parsing JSON arrays as lists instead of vectors
 (define array-as-list-parser
@@ -534,6 +551,78 @@ h1, h2, h3, h4, h5, h6 {
                                                       (Authorization ,(conc "Bearer " api-token)))))))
           (with-input-from-request req #f read-json))))))
 
+(define (get-cloudflare-domains api-token)
+  (map
+   (lambda (x)
+     (alist-ref 'name x))
+   (alist-ref
+    'result
+    (let* ((uri (uri-reference "https://api.cloudflare.com/client/v4/zones"))
+         (req (make-request method: 'GET
+                            uri: uri
+                            headers: (headers `((Authorization #(,(conc "Bearer " api-token) raw)))))))
+  (with-input-from-request req #f read-json)
+  ;; (handle-exceptions exn (get-condition-property exn 'client-error 'body)
+  ;;                    (with-input-from-request req #f read-json))
+  ))))
+
+;; TODO this currently only supports the first page
+;; Example return json:
+;; ((result ((id . "aaa") (name . "example.org") (status . "active")
+;;           (paused . #f) (type . "full") (development_mode . 0)
+;;           (name_servers "abby.ns.cloudflare.com" "toby.ns.cloudflare.com")
+;;           (original_name_servers . null) (original_registrar . null) (original_dnshost . null)
+;;           (modified_on . "2025-08-13T17:17:10.664419Z") (created_on . "2025-08-13T17:17:05.956271Z")
+;;           (activated_on . "2025-08-13T17:17:10.476671Z") (vanity_name_servers)
+;;           (vanity_name_servers_ips . null)
+;;           (meta (step . 4) (custom_certificate_quota . 0) (page_rule_quota . 3) (phishing_detected . #f))
+;;           (owner (id . null) (type . "user") (email . null))
+;;           (account (id . "aaa") (name . "XXX's Account"))
+;;           (tenant (id . null) (name . null)) (tenant_unit (id . null))
+;;           (permissions "#dns_records:edit" "#dns_records:read" "#zone:read")
+;;           (plan (id . "0feeeeeeeeeeeeeeeeeeeeeeeeeeeeee") (name . "Free Website") (price . 0)
+;;                 (currency . "USD") (frequency . "") (is_subscribed . #f) (can_subscribe . #f)
+;;                 (legacy_id . "free") (legacy_discount . #f) (externally_managed . #f))))
+;;  (result_info (page . 1) (per_page . 20) (total_pages . 1) (count . 1) (total_count . 1))
+;;  (success . #t) (errors) (messages))
+(define (test-cloudflare-connection api-token zone-id account-id)
+  (let* ((uri (uri-reference "https://api.cloudflare.com/client/v4/zones"))
+         (req (make-request method: 'GET
+                            uri: uri
+                            headers: (headers `((Authorization #(,(conc "Bearer " api-token) raw)))))))
+    (let ((res (handle-exceptions exn (read-json (get-condition-property exn 'client-error 'body))
+                                  (with-input-from-request req #f read-json))))
+      (if (alist-ref 'success res)
+          (let ((matches
+                 (filter (lambda (x) (and (string=? (alist-ref 'id x) zone-id)
+                                          (string=? (alist-ref 'id (alist-ref 'account x)) account-id)))
+                         (alist-ref 'result res))))
+            (if (null? matches)
+                '((success . #f)
+                  (errors ((message . "Account ID and/or Zone ID does not match API Token."))))
+                '((success . #t)
+                  (result ,matches))))
+          res))))
+
+(define (test-digitalocean-connection api-token)
+  (let* ((uri (uri-reference "https://api.digitalocean.com/v2/account"))
+         (req (make-request method: 'GET
+                            uri: uri
+                            headers: (headers `((Authorization #(,(conc "Bearer " api-token) raw)))))))
+    (let ((res (handle-exceptions exn (read-json (get-condition-property exn 'client-error 'body))
+                                  (with-input-from-request req #f read-json))))
+      (if (alist-ref 'account res)
+          (if (string=? (alist-ref 'status (alist-ref 'account res)) "active")
+              `((success . #t)
+                (result ,res))
+              '((success . #f)
+                (errors ((message . "Token is valid but account status is not 'active'.")))))
+          `((success . #f)
+            (errors ((message . ,(alist-ref 'message res)))))))))
+
+;; (define (test-backblaze-connection key-id application-key bucket-url)
+;;   )
+
 (define (deployment-directory user-id)
   (string-append "deploy-" (number->string user-id)))
 
@@ -579,13 +668,84 @@ h1, h2, h3, h4, h5, h6 {
     ((complete) "complete")
     ((failed) "failed")))
 
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (update-instance-ssh-pub-key db 1 22 "")))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (get-instance-ssh-pub-key db 1 22)))
+
+;; Generates an ssh key via ssh-keygen running in docker
+;; Returns a list with the first element being the private key
+;; and the second element being the corresponding public key.
+;; Does not leave a trace of the generated keys on the filesystem.
+(define (generate-ssh-key user-id)
+  (define (generate-ssh-key_ filepath counter)
+    (if (directory-exists? (conc filepath counter))
+        (generate-ssh-key_ filepath (+ counter 1))
+        (conc filepath counter)))
+  (let ((key-path (generate-ssh-key_ (conc "temp-ssh-keys-" user-id "-") 0)))
+    (create-directory key-path)
+    (receive (in-port out-port pid err-port)
+        ;; There are docker images that exist that include ssh-keygen
+        ;; but none of them are "official". For something sensitive like
+        ;; this it seems much better to only use an official image so there
+        ;; is less chance of an image doing something malicious and we don't
+        ;; notice when updating the image this command uses.
+        ;;
+        ;; This command maps a volume to the unique directory we created above
+        ;; and uses that to store the generated ssh keys.
+        ;; Later on this directory gets deleted after we read the keys into
+        ;; strings to return from this function.
+        (process* "docker" `("run" "--rm" "--volume"
+                             ,(conc (current-directory) "/" key-path ":/opt/keys")
+                             "debian:12-slim" "bash" "-c" "apt update
+apt install -y openssh-client
+ssh-keygen -t ed25519 -f /opt/keys/key -N \"\"
+chmod -R 777 /opt/keys"))
+      (let ((thread
+             (thread-start!
+              (lambda ()
+                (let loop ()
+                  (thread-sleep! 1)
+                  ;; We do a non-blocking wait here so that we don't
+                  ;; block the entire web process.
+                  (receive (wait-pid exit-normal status) (process-wait pid #t)
+                    (if (= wait-pid 0) ;; wait-pid is 0 until the process has finished
+                        (loop)
+                        (let ((priv-key (with-input-from-file (conc key-path "/key") read-string))
+                              (pub-key (with-input-from-file (conc key-path "/key.pub") read-string)))
+                          (with-input-from-port in-port read-string) ;; left here for debugging and to clear ports
+                          (with-input-from-port err-port read-string) ;; left here for debugging and to clear ports
+                          (delete-directory key-path #t)
+                          (list priv-key pub-key)))))))))
+        (thread-join! thread)))))
+
+(define (generate-restic-password)
+  (generator->string (gtake (make-random-char-generator
+                             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()_-+={}[]|<>,.?")
+                            30)))
+
+(define (generate-postgres-password)
+  (generator->string (gtake (make-random-char-generator
+                             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+                            40)))
+
+(define (generate-redis-password)
+  (generator->string (gtake (make-random-char-generator
+                             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+                            40)))
+
 (with-schematra-app app
   (lambda ()
 
 (post "/config/wizard/create-instance"
- (let ((instance-id (with-db/transaction
+ (let* ((ssh-keys (generate-ssh-key (session-user-id)))
+        (instance-id (with-db/transaction
                       (lambda (db)
-                       (create-instance db (session-user-id))))))
+                        (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
@@ -638,7 +798,15 @@ h1, h2, h3, h4, h5, h6 {
 
 (get/widgets
  ("/config/wizard/services-success/:id")
- (let ((instance-id (alist-ref "id" (current-params) equal?)))
+ (let* ((instance-id (alist-ref "id" (current-params) equal?))
+        (service-config
+         (with-db/transaction
+          (lambda (db)
+            (get-user-service-config db (session-user-id) instance-id))))
+        (cloudflare-result (test-cloudflare-connection (alist-ref 'cloudflare-api-token service-config)
+                                                       (alist-ref 'cloudflare-zone-id service-config)
+                                                       (alist-ref 'cloudflare-account-id service-config)))
+        (digitalocean-result (test-digitalocean-connection (alist-ref 'digitalocean-api-token service-config))))
    `(App
      (Configuration-Wizard
       (@ (step "Services"))
@@ -647,17 +815,37 @@ h1, h2, h3, h4, h5, h6 {
        (VStack
         (Fieldset
          (@ (title "Cloudflare"))
-         (h3 "Connected")
+         ,@(if (alist-ref 'success cloudflare-result)
+               `((h3 "Connected")
                  (p "Your Cloudflare account was successfully connected!"))
+               `((h3 "Connection Failed")
+                 (p "Unable to make a connection via Cloudflare API. Message is: \""
+                    ,(string-intersperse
+                      (map (lambda (err)
+                             (alist-ref 'message err))
+                           (alist-ref 'errors cloudflare-result))
+                      "\" & \"")
+                    "\""))))
         (Fieldset
          (@ (title "DigitalOcean"))
-         (h3 "Connected")
+         ,@(if (alist-ref 'success digitalocean-result)
+               `((h3 "Connected")
                  (p "Your DigitalOcean account was successfully connected!"))
+               `((h3 "Connection Failed")
+                 (p "Unable to make a connection via DigitalOcean API. Message is: \""
+                    ,(string-intersperse
+                      (map (lambda (err)
+                             (alist-ref 'message err))
+                           (alist-ref 'errors digitalocean-result))
+                      "\" & \"")
+                    "\""))))
         (Fieldset
          (@ (title "Backblaze"))
          (h3 "Connected")
          (p "Your Backblaze account was successfully connected!"))
-        (Form-Nav (@ (back-to ,(conc "/config/wizard/services/" instance-id))))))))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/services/" instance-id))
+                     (submit-enabled ,(and (alist-ref 'success cloudflare-result)
+                                           (alist-ref 'success digitalocean-result)))))))))))
 
 (get/widgets
  ("/config/wizard/apps/:id")
@@ -669,7 +857,8 @@ h1, h2, h3, h4, h5, h6 {
                                  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)))))))
+              (app-config . ,(get-user-app-config db (session-user-id) instance-id))
+              (service-config . ,(get-user-service-config db (session-user-id) instance-id)))))))
    `(App
      (Configuration-Wizard
       (@ (step "Apps"))
@@ -679,13 +868,24 @@ h1, h2, h3, h4, h5, h6 {
         (Fieldset
          (@ (title "Root Domain"))
          (Field (@ (element select) (name "root-domain"))
-                (option (@ (value ,(or (alist-ref 'root-domain (alist-ref 'app-config results)) "nassella.cc"))) "nassella.cc"))) ;; TODO fetch from cloudflare API?
+                ,@(map (lambda (domain)
+                         `(option (@ (value ,domain)
+                                     ,@(if (equal? domain
+                                                   (alist-ref 'root-domain (alist-ref 'app-config results)))
+                                           '(selected)
+                                           '()))
+                                  ,domain))
+                       (get-cloudflare-domains (alist-ref 'cloudflare-api-token
+                                                          (alist-ref 'service-config results))))
+                ))
         (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 "ghost") (type "checkbox") (label ("Ghost")) (checked ,(member 'ghost (alist-ref 'selected-apps results)))))
          (Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
+        ;; TODO add config for when automatic upgrades are scheduled for?
+        ;; TODO add config for server timezone?
         (Form-Nav (@ (back-to ,(conc "/config/wizard/services-success/" instance-id))))))))))
 
 (post "/config/wizard/apps-submit/:id"
@@ -696,9 +896,9 @@ h1, h2, h3, h4, h5, h6 {
         db
         (session-user-id)
         instance-id
-        `((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "0.0") (sql-null)))
+        `((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "15.1.0") (sql-null)))
-          (nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "0.0") (sql-null)))
+          (nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "31.0.8") (sql-null)))
-          (ghost . ,(or (and (alist-ref 'ghost (current-params)) "0.0") (sql-null)))))
+          (ghost . ,(or (and (alist-ref 'ghost (current-params)) "6.10.0") (sql-null)))))
        (update-root-domain db
                            (session-user-id)
                            instance-id
@@ -774,15 +974,28 @@ h1, h2, h3, h4, h5, h6 {
  (let ((instance-id (alist-ref "id" (current-params) equal?)))
    (with-db/transaction
     (lambda (db)
+      (let ((config (alist-ref 'config (get-user-app-config db (session-user-id) instance-id))))
         (update-user-app-config
          db
          (session-user-id)
          instance-id
-       `((ghost . ((subdomain . ,(alist-ref 'ghost-subdomain (current-params)))))
+         `((ghost . ((subdomain . ,(alist-ref 'ghost-subdomain (current-params)))
+                     (postgres-root-password . ,(or (alist-ref 'postgres-root-password
+                                                               (alist-ref 'ghost config eq? '()))
+                                                    (generate-postgres-password)))
+                     (postgres-password . ,(or (alist-ref 'postgres-password
+                                                          (alist-ref 'ghost config eq? '()))
+                                               (generate-postgres-password)))))
            (wg-easy . ((subdomain . ,(alist-ref 'wg-easy-subdomain (current-params)))))
            (nextcloud . ((subdomain . ,(alist-ref 'nextcloud-subdomain (current-params)))
                          (admin-user . ,(alist-ref 'nextcloud-admin-user (current-params)))
-                       (admin-password . ,(alist-ref 'nextcloud-admin-password (current-params)))))
+                         (admin-password . ,(alist-ref 'nextcloud-admin-password (current-params)))
+                         (postgres-password . ,(or (alist-ref 'postgres-password
+                                                              (alist-ref 'nextcloud config eq? '()))
+                                                   (generate-postgres-password)))
+                         (redis-password . ,(or (alist-ref 'redis-password
+                                                           (alist-ref 'nextcloud config eq? '()))
+                                                (generate-redis-password)))))
            (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)))))
@@ -790,7 +1003,7 @@ h1, h2, h3, h4, h5, h6 {
                         (smtp-port . ,(alist-ref 'smtp-port (current-params)))
                         (smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params)))
                         (smtp-auth-password . ,(alist-ref 'smtp-auth-password (current-params)))
-                      (smtp-from . ,(alist-ref 'smtp-from (current-params)))))))))
+                        (smtp-from . ,(alist-ref 'smtp-from (current-params))))))))))
    (redirect (conc "/config/wizard/machine/" instance-id))))
 
 (get/widgets
@@ -815,6 +1028,8 @@ h1, h2, h3, h4, h5, h6 {
                        (get-digital-ocean-regions (alist-ref 'digitalocean-api-token config)))))
         (Form-Nav (@ (back-to ,(conc "/config/wizard/apps2/" instance-id))))))))))
 
+;; TODO if the region is changed, all of the data is DELETED because the
+;; volume is deleted and re-created
 (post "/config/wizard/machine-submit/:id"
       (let ((instance-id (alist-ref "id" (current-params) equal?)))
         (with-db/transaction
@@ -902,8 +1117,11 @@ h1, h2, h3, h4, h5, h6 {
        (VStack
         (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2/" instance-id)) (submit-button "Launch")))))))))
 
+;; TODO run restic-init if needed (like the first run or if the backblaze
+;; config changes
 ;; TODO this can only handle a user deploying one instance at a time!
 ;; the folder used should be the user-id PLUS the instance id
+;; TODO should this perform a backup and then run the systemctl stop app command first?
 (post "/config/wizard/review-submit/:id"
       (let* ((instance-id (alist-ref "id" (current-params) equal?))
              (results
@@ -915,13 +1133,17 @@ h1, h2, h3, h4, h5, h6 {
                                               (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))))))
+                   (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))))
         (setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
         (with-output-to-file (string-append dir "/config/apps.config")
@@ -942,10 +1164,10 @@ h1, h2, h3, h4, h5, h6 {
                    ("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
                    ("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
                    ("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
-              ("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword") ;; TODO generate
+                   ("NEXTCLOUD_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
-              ("NEXTCLOUD_REDIS_PASSWORD" . "redispassword") ;; TODO generate
+                   ("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
-              ("GHOST_DATABASE_ROOT_PASSWORD" . "reallysecurerootpassword") ;; TODO generate
+                   ("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
-              ("GHOST_DATABASE_PASSWORD" . "ghostpassword") ;; TODO generate
+                   ("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)))
@@ -954,7 +1176,7 @@ h1, h2, h3, h4, h5, h6 {
                    ("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"))))) ;; TODO generate or get from user
+                   ("RESTIC_PASSWORD" . ,restic-password)))))
         (with-output-to-file (string-append dir "/config/production.tfvars")
           (lambda ()
             (map (lambda (e)
@@ -967,7 +1189,8 @@ h1, h2, h3, h4, h5, h6 {
                    ("cluster_name" . "mycluster")
                    ("datacenter" . ,(alist-ref 'digitalocean-region service-config))
                    ("flatcar_stable_version" . "4459.2.1")))
-       (display "ssh_keys=[\"") (display (with-input-from-file (string-append dir "/config/ssh-keys") read-string)) (print "\"]"))))
+            ;; 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?))
              (user-id (session-user-id))
              (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
@@ -975,25 +1198,33 @@ h1, h2, h3, h4, h5, h6 {
         (thread-start!
          (lambda ()
            (change-directory dir)
-      (let ((pid (process-run "make apply > make-out")))
+           (let ((pid (process-run "make apply > 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)
+                 (if (= pid 0) ;; process is still running
                      (begin (let ((progress (parse-deployment-log
                                              (with-input-from-file
                                                  (string-append (deployment-directory user-id) "/make-out")
-                                          read-string))))
+                                               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-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) "/make-out")
-                                   read-string))))
+                                        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)
@@ -1008,12 +1239,20 @@ h1, h2, h3, h4, h5, h6 {
                            (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
-                                                  (with-input-from-file (string-append dir "/terraform.tfstate") read-string)
+                                                       (if (eof-object? tf-state) "" tf-state)
-                                                  (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))))))))))))
+                                                       (if (eof-object? tf-state-backup) "" tf-state-backup))))))))))))
       (redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))
 
 (get/widgets
- ("/config/wizard/success/:id")
+ ("/config/wizard/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 (string->symbol (alist-ref 'status res))))
+    (if (or (eq? status 'complete) (eq? status 'failed))
+        '()
+        '((meta (@ (http-equiv "refresh") (content "5")))))))
  (let* ((instance-id (alist-ref "id" (current-params) equal?))
         (res (with-db/transaction
               (lambda (db)
@@ -1022,7 +1261,9 @@ h1, h2, h3, h4, h5, h6 {
         (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)))
-   `(VStack
+   `(App
+     (Main-Container
+      (VStack
        (h1
         ,(case (string->symbol status)
            ((queued) "Deployment queued")
@@ -1033,8 +1274,15 @@ h1, h2, h3, h4, h5, h6 {
            (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))))
-     (pre ,output)
+       (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)
+       )))))
 
 (get/widgets
  ("/dashboard")
@@ -1046,13 +1294,45 @@ h1, h2, h3, h4, h5, h6 {
       (@ (action "/config/wizard/create-instance")
          (method POST))
       (Button "Setup New Instance"))
-     (ul ,@(map (lambda (deployment)
+     (ul ,@(map (lambda (instance)
-                  `(li (a (@ (href ,(conc "/deployments/" (alist-ref 'id deployment))))
+                  (let ((root-domain (alist-ref 'root-domain instance))
-                          ,(alist-ref 'root-domain deployment))
+                        (config (alist-ref 'config instance)))
-                       " - ",(alist-ref 'status deployment)))
+                    `(li (VStack
+                          (h2 ,root-domain)
+                          (HStack
+                           "status: " ,(if (equal? (alist-ref 'status instance) "complete")
+                                           "deployed successfully"
+                                           (alist-ref 'status instance)))
+                          (h3 "Apps")
+                          (ul ,@(filter
+                                 identity
+                                 (map (lambda (app-map)
+                                        (let ((app (car app-map))
+                                              (doc-url (cdr app-map)))
+                                          (if (or (alist-ref app instance)
+                                                  (eq? app 'log-viewer))
+                                              `((li (a (@ (href ,doc-url)) ,app)
+                                                    " (v" ,(alist-ref app instance eq? "-") ") "
+                                                    (a (@ (href "https://"
+                                                                ,(alist-ref 'subdomain (alist-ref app config))
+                                                                "." ,root-domain))
+                                                       ,(alist-ref 'subdomain (alist-ref app config))
+                                                       "." ,root-domain)))
+                                              #f)))
+                                      '((wg-easy . "https://wg-easy.github.io/wg-easy/Pre-release/")
+                                        (nextcloud . "https://nextcloud.com/support/")
+                                        (ghost . "https://nextcloud.com/support/")
+                                        (log-viewer . "https://nextcloud.com/support/")))))
+                          (h3 "Actions")
+                          (ul (li (a (@ (href "/config/wizard/services/"
+                                              ,(alist-ref 'instance-id instance)))
+                                     "Modify Setup"))
+                              (li "Upgrade Now (pending automatic upgrades scheduled for: )")
+                              (li "Manage Backups")
+                              (li "Destroy"))))))
                 (with-db/transaction
                  (lambda (db)
-                   (get-user-deployments db (session-user-id))))))))))
+                   (get-dashboard db (session-user-id))))))))))
 
 (schematra-install)