Refactor to support multiple instances.

2025-11-30 20:13:51 -08:00
parent e372f2157b
commit 284b4c37f4
4 changed files with 418 additions and 327 deletions
--- a/src/nassella.scm
+++ b/src/nassella.scm
@@ -288,7 +288,7 @@ h1, h2, h3, h4, h5, h6 {
  (lambda ()
    (use-middleware! (session-middleware "your-secret-key-here")))) ;; TODO generate better one

-(define test-user-id (make-parameter 7))
+(define test-user-id (make-parameter 1))
 (define (session-user-id)
  (or (session-get "user-id") (test-user-id)))

@@ -576,14 +576,26 @@ h1, h2, h3, h4, h5, h6 {
 (with-schematra-app app
  (lambda ()

+(post "/config/wizard/create-instance"
+ (let ((instance-id (with-db/transaction
+                     (lambda (db)
+                       (create-instance db (session-user-id))))))
+   (redirect (conc "/config/wizard/services/" instance-id))))
+
+;; TODO should all these key related form fields be of type password
+;; so the browser doesn't save them???
 (get/widgets
- ("/config/wizard/services")
- (let ((config (with-db/transaction (lambda (db) (get-user-service-config db (session-user-id))))))
+ ("/config/wizard/services/:id")
+ (let* ((instance-id (alist-ref "id" (current-params) equal?))
+        (config (with-db/transaction
+                 (lambda (db)
+                   (get-user-service-config db (session-user-id)
+                                            instance-id)))))
   `(App
     (Configuration-Wizard
      (@ (step "Services"))
      (form
-       (@ (action "/config/wizard/services-submit")
+       (@ (action ,(conc "/config/wizard/services-submit/" instance-id))
          (method POST))
       (VStack
        (Fieldset
@@ -601,102 +613,111 @@ h1, h2, h3, h4, h5, h6 {
         (Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (value ,(alist-ref 'backblaze-bucket-url config)))))
        (Form-Nav)))))))

-(post "/config/wizard/services-submit"
- (with-db/transaction
-  (lambda (db)
-    (update-user-service-config
-     db
-     (session-user-id)
-     `((cloudflare-api-token . ,(alist-ref 'cloudflare-api-token (current-params)))
-       (cloudflare-account-id . ,(alist-ref 'cloudflare-account-id (current-params)))
-       (cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (current-params)))
-       (digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (current-params)))
-       (backblaze-application-key . ,(alist-ref 'backblaze-application-key (current-params)))
-       (backblaze-key-id . ,(alist-ref 'backblaze-key-id (current-params)))
-       (backblaze-bucket-url . ,(alist-ref 'backblaze-bucket-url (current-params)))))))
- (redirect "/config/wizard/services-success"))
+(post "/config/wizard/services-submit/:id"
+ (let ((instance-id (alist-ref "id" (current-params) equal?)))
+   (with-db/transaction
+    (lambda (db)
+      (update-user-service-config
+       db
+       (session-user-id)
+       instance-id
+       `((cloudflare-api-token . ,(alist-ref 'cloudflare-api-token (current-params)))
+         (cloudflare-account-id . ,(alist-ref 'cloudflare-account-id (current-params)))
+         (cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (current-params)))
+         (digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (current-params)))
+         (backblaze-application-key . ,(alist-ref 'backblaze-application-key (current-params)))
+         (backblaze-key-id . ,(alist-ref 'backblaze-key-id (current-params)))
+         (backblaze-bucket-url . ,(alist-ref 'backblaze-bucket-url (current-params)))))))
+   (redirect (conc "/config/wizard/services-success/" instance-id))))

 (get/widgets
- ("/config/wizard/services-success")
- `(App
-   (Configuration-Wizard
-    (@ (step "Services"))
-    (form
-     (@ (action "/config/wizard/apps"))
-     (VStack
-      (Fieldset
-       (@ (title "Cloudflare"))
-       (h3 "Connected")
-       (p "Your Cloudflare account was successfully connected!"))
-      (Fieldset
-       (@ (title "DigitalOcean"))
-       (h3 "Connected")
-       (p "Your DigitalOcean account was successfully connected!"))
-      (Fieldset
-       (@ (title "Backblaze"))
-       (h3 "Connected")
-       (p "Your Backblaze account was successfully connected!"))
-      (Form-Nav (@ (back-to "/config/wizard/services"))))))))
-
-(get/widgets
- ("/config/wizard/apps")
- (let ((results
-        (with-db/transaction
-         (lambda (db)
-           `((selected-apps . ,(map
-                                car
-                                (filter cdr
-                                        (get-user-selected-apps db (session-user-id)))))
-             (app-config . ,(get-user-app-config db (session-user-id))))))))
+ ("/config/wizard/services-success/:id")
+ (let ((instance-id (alist-ref "id" (current-params) equal?)))
   `(App
     (Configuration-Wizard
-      (@ (step "Apps"))
+      (@ (step "Services"))
      (form
-       (@ (action "/config/wizard/apps-submit") (method POST))
+       (@ (action ,(conc "/config/wizard/apps/" instance-id)))
       (VStack
        (Fieldset
-         (@ (title "Root Domain"))
-         (Field (@ (element select) (name "root-domain"))
-                (option (@ (value ,(alist-ref 'root-domain (alist-ref 'app-config results)))) "nassella.cc"))) ;; TODO fetch from cloudflare API?
+         (@ (title "Cloudflare"))
+         (h3 "Connected")
+         (p "Your Cloudflare account was successfully connected!"))
        (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 "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
-        (Form-Nav (@ (back-to "/config/wizard/services-success")))))))))
+         (@ (title "DigitalOcean"))
+         (h3 "Connected")
+         (p "Your DigitalOcean account was successfully connected!"))
+        (Fieldset
+         (@ (title "Backblaze"))
+         (h3 "Connected")
+         (p "Your Backblaze account was successfully connected!"))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/services/" instance-id))))))))))

-(post "/config/wizard/apps-submit"
-  (with-db/transaction
-   (lambda (db)
-     (update-user-selected-apps
-      db
-      (session-user-id)
-      `((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "0.0") (sql-null)))
-        (nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "0.0") (sql-null)))))
-     (update-root-domain db
-                         (session-user-id)
-                         (alist-ref 'root-domain (current-params)))))
- (redirect "/config/wizard/apps2"))
-
-;; TODO should this even allow changing existing username/passwords like for db?
-;; wouldn't that break the db connection and you would lose data?
 (get/widgets
- ("/config/wizard/apps2")
- (let* ((results
+ ("/config/wizard/apps/: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)))))
-              (app-config . ,(get-user-app-config db (session-user-id)))))))
+                                         (get-user-selected-apps db (session-user-id) instance-id))))
+              (app-config . ,(get-user-app-config db (session-user-id) instance-id)))))))
+   `(App
+     (Configuration-Wizard
+      (@ (step "Apps"))
+      (form
+       (@ (action ,(conc "/config/wizard/apps-submit/" instance-id)) (method POST))
+       (VStack
+        (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?
+        (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 "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/services-success/" instance-id))))))))))
+
+(post "/config/wizard/apps-submit/:id"
+  (display "root domain: ") (print (alist-ref 'root-domain (current-params)))
+  (let ((instance-id (alist-ref "id" (current-params) equal?)))
+    (with-db/transaction
+     (lambda (db)
+       (update-user-selected-apps
+        db
+        (session-user-id)
+        instance-id
+        `((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "0.0") (sql-null)))
+          (nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "0.0") (sql-null)))))
+       (update-root-domain db
+                           (session-user-id)
+                           instance-id
+                           (alist-ref 'root-domain (current-params)))))
+    (redirect (conc "/config/wizard/apps2/" instance-id))))
+
+;; TODO should this even allow changing existing username/passwords like for db?
+;; wouldn't that break the db connection and you would lose data?
+(get/widgets
+ ("/config/wizard/apps2/: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))))))
        (selected-apps (alist-ref 'selected-apps results))
        (app-config (alist-ref 'config (alist-ref 'app-config results))))
   `(App
     (Configuration-Wizard
      (@ (step "Apps"))
      (form
-       (@ (action "/config/wizard/apps2-submit") (method POST))
+       (@ (action ,(conc "/config/wizard/apps2-submit/" instance-id)) (method POST))
       (VStack
        ,@(if (member 'wg-easy selected-apps)
              `((Fieldset
@@ -721,33 +742,36 @@ h1, h2, h3, h4, h5, h6 {
                   (value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
         (Field (@ (name "log-viewer-password") (label ("Password")) (type "password")
                   (value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? "")))))
-        (Form-Nav (@ (back-to "/config/wizard/apps")))))))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/apps/" instance-id))))))))))

-(post "/config/wizard/apps2-submit"
-  (with-db/transaction
-   (lambda (db)
-     (update-user-app-config
-      db
-      (session-user-id)
-      `((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)))))
-        (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)))))))))
- (redirect "/config/wizard/machine"))
+(post "/config/wizard/apps2-submit/:id"
+ (let ((instance-id (alist-ref "id" (current-params) equal?)))
+   (with-db/transaction
+    (lambda (db)
+      (update-user-app-config
+       db
+       (session-user-id)
+       instance-id
+       `((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)))))
+         (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)))))))))
+   (redirect (conc "/config/wizard/machine/" instance-id))))

 (get/widgets
- ("/config/wizard/machine")
- (let ((config (with-db/transaction
-                (lambda (db)
-                  (get-user-service-config db (session-user-id))))))
+ ("/config/wizard/machine/:id")
+ (let* ((instance-id (alist-ref "id" (current-params) equal?))
+        (config (with-db/transaction
+                 (lambda (db)
+                   (get-user-service-config db (session-user-id) instance-id)))))
   `(App
     (Configuration-Wizard
      (@ (step "Machine"))
      (form
-       (@ (action "/config/wizard/machine-submit")
+       (@ (action ,(conc "/config/wizard/machine-submit/" instance-id))
          (method POST))
       (VStack
        (Fieldset
@@ -757,22 +781,25 @@ h1, h2, h3, h4, h5, h6 {
                ,@(map (lambda (r)
                         `(option (@ (value ,(alist-ref 'slug r))) ,(alist-ref 'name r)))
                       (get-digital-ocean-regions (alist-ref 'digitalocean-api-token config)))))
-        (Form-Nav (@ (back-to ,(conc "/config/wizard/apps2"))))))))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/apps2/" instance-id))))))))))

-(post "/config/wizard/machine-submit"
- (with-db/transaction
-  (lambda (db)
-    (update-user-service-config
-     db
-     (session-user-id)
-     `((digitalocean-region . ,(alist-ref 'region (current-params)))))))
- (redirect "/config/wizard/machine2"))
+(post "/config/wizard/machine-submit/:id"
+ (let ((instance-id (alist-ref "id" (current-params) equal?)))
+   (with-db/transaction
+    (lambda (db)
+      (update-user-service-config
+       db
+       (session-user-id)
+       instance-id
+       `((digitalocean-region . ,(alist-ref 'region (current-params)))))))
+   (redirect (conc "/config/wizard/machine2/" instance-id))))

 (get/widgets
- ("/config/wizard/machine2")
- (let* ((config (with-db/transaction
+ ("/config/wizard/machine2/:id")
+ (let* ((instance-id (alist-ref "id" (current-params) equal?))
+        (config (with-db/transaction
                 (lambda (db)
-                   (get-user-service-config db (session-user-id)))))
+                   (get-user-service-config db (session-user-id) instance-id))))
        (region (alist-ref 'digitalocean-region config))
        (all-sizes (get-digital-ocean-sizes (alist-ref 'digitalocean-api-token config)))
        (sizes (filter (lambda (s) (member region (alist-ref 'regions s))) all-sizes)))
@@ -780,7 +807,7 @@ h1, h2, h3, h4, h5, h6 {
     (Configuration-Wizard
      (@ (step "Machine"))
      (form
-       (@ (action "/config/wizard/machine2-submit")
+       (@ (action ,(conc "/config/wizard/machine2-submit/" instance-id))
          (method POST))
       (VStack
        (Fieldset
@@ -794,28 +821,31 @@ h1, h2, h3, h4, h5, h6 {
                                            " Disk: " ,(alist-ref 'disk s)
                                            ") " ,(alist-ref 'description s)))
                       sizes)))
-        (Form-Nav (@ (back-to ,(conc "/config/wizard/machine"))))))))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/machine/" instance-id))))))))))

-(post "/config/wizard/machine2-submit"
- (with-db/transaction
-  (lambda (db)
-    (update-user-service-config
-     db
-     (session-user-id)
-     `((digitalocean-size . ,(alist-ref 'size (current-params)))))))
- (redirect "/config/wizard/review"))
+(post "/config/wizard/machine2-submit/:id"
+ (let ((instance-id (alist-ref "id" (current-params) equal?)))
+   (with-db/transaction
+    (lambda (db)
+      (update-user-service-config
+       db
+       (session-user-id)
+       instance-id
+       `((digitalocean-size . ,(alist-ref 'size (current-params)))))))
+   (redirect (conc "/config/wizard/review/" instance-id))))

 (get/widgets
- ("/config/wizard/review")
- (let* ((results
+ ("/config/wizard/review/: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)))))
-              (app-config . ,(get-user-app-config db (session-user-id)))
-              (service-config . ,(get-user-service-config db (session-user-id)))))))
+                                         (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))))))
        (selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
        (app-config (alist-ref 'app-config results))
        (config (alist-ref 'config app-config))
@@ -836,21 +866,24 @@ h1, h2, h3, h4, h5, h6 {
      (ul (li "Region: " ,(alist-ref 'digitalocean-region service-config))
          (li "Size: " ,(alist-ref 'digitalocean-size service-config)))
      (form
-       (@ (action "/config/wizard/review-submit") (method POST))
+       (@ (action ,(conc "/config/wizard/review-submit/" instance-id)) (method POST))
       (VStack
-        (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch")))))))))
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2/" instance-id)) (submit-button "Launch")))))))))

-(post "/config/wizard/review-submit"
- (let* ((results
+;; 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
+(post "/config/wizard/review-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)))))
-              (app-config . ,(get-user-app-config db (session-user-id)))
-              (service-config . ,(get-user-service-config db (session-user-id)))
-              (terraform-state . ,(get-user-terraform-state db (session-user-id)))))))
+                                         (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))))))
        (selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
        (app-config (alist-ref 'app-config results))
        (config (alist-ref 'config app-config))
@@ -896,8 +929,9 @@ h1, h2, h3, h4, h5, h6 {
              ("datacenter" . ,(alist-ref 'digitalocean-region service-config))
              ("flatcar_stable_version" . "4230.2.3")))
       (display "ssh_keys=[\"") (display (with-input-from-file (string-append dir "/config/ssh-keys") read-string)) (print "\"]"))))
- (let* ((user-id (session-user-id))
-        (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id))))
+ (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)))
   (thread-start!
    (lambda ()
@@ -918,9 +952,9 @@ h1, h2, h3, h4, h5, h6 {
                            (update-deployment-progress db deployment-id progress))))
                       (loop))
                (let ((progress (parse-deployment-log
-                                        (with-input-from-file
-                                            (string-append (deployment-directory user-id) "/make-out")
-                                          read-string))))
+                                 (with-input-from-file
+                                     (string-append (deployment-directory user-id) "/make-out")
+                                   read-string))))
                  (with-db/transaction
                   (lambda (db)
                     (update-deployment-progress db deployment-id progress)
@@ -934,17 +968,18 @@ h1, h2, h3, h4, h5, h6 {
                      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
+                     (update-user-terraform-state db user-id instance-id
                                                  (with-input-from-file (string-append dir "/terraform.tfstate") read-string)
                                                  (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))))))))))))
-  (redirect "/config/wizard/success"))
+ (redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))

 (get/widgets
- ("/config/wizard/success")
- (let* ((res (with-db/transaction
+ ("/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)))
-                  (progress . ,(get-most-recent-deployment-progress db (session-user-id)))))))
+                `((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id))
+                  (progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id))))))
        (output (with-input-from-file (string-append (deployment-directory (session-user-id)) "/make-out") read-string))
        (progress (alist-ref 'progress res))
        (status (alist-ref 'status res)))
@@ -967,10 +1002,13 @@ h1, h2, h3, h4, h5, h6 {
 `(App
   (Main-Container
    (main
-     (h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Deployments")
-     (Button "Setup New Deployment")
+     (h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Instances")
+     (form
+      (@ (action "/config/wizard/create-instance")
+         (method POST))
+      (Button "Setup New Instance"))
     (ul ,@(map (lambda (deployment)
-                  `(li (a (@ (href ,(string-append "/deployments/" (number->string (alist-ref 'id deployment)))))
+                  `(li (a (@ (href ,(conc "/deployments/" (alist-ref 'id deployment))))
                          ,(alist-ref 'root-domain deployment))
                       " - ",(alist-ref 'status deployment)))
                (with-db/transaction