Postgres db integration.

src/compose.yaml

@@ -0,0 +1,15 @@
+services:
+  db:
+    image: postgres
+    restart: always
+    environment:
+      POSTGRES_USER: nassella
+      POSTGRES_PASSWORD: password
+      POSTGRES_DB: nassella
+    healthcheck:
+      test: ["CMD-SHELL", "pg_isready", "-U", "nassella"]
+      interval: 1s
+      timeout: 5s
+      retries: 10
+    ports:
+      - "5432:5432"

src/db-init.sql

@@ -0,0 +1,41 @@
+create table users(
+       user_id bigserial primary key,
+       auth_user_id int unique not null,
+       email varchar(255) not null,
+       username varchar(255) not null unique,
+       key_key varchar(255),
+       key_iv varchar(255));
+create unique index users_auth_user_id_idx on users (auth_user_id);
+
+create table user_service_configs(
+       id bigserial primary key,
+       user_id integer unique not null references users on delete cascade,
+       cloudflare_api_token_enc varchar(255),
+       cloudflare_account_id_enc varchar(255),
+       cloudflare_zone_id_enc varchar(255),
+       digitalocean_api_token_enc varchar(255),
+       digitalocean_region varchar(255),
+       digitalocean_size varchar(255),
+       backblaze_application_key_enc varchar(255),
+       backblaze_key_id_enc varchar(255),
+       backblaze_bucket_url_enc varchar(255)
+       );
+create unique index user_service_configs_user_id_idx on user_service_configs (user_id);
+
+create table user_selected_apps(
+       id bigserial primary key,
+       user_id integer unique not null references users on delete cascade,
+       wg_easy_version varchar(100),
+       nextcloud_version varchar(100),
+       log_viewer_version varchar(100)
+       );
+create unique index user_selected_apps_user_id_idx on user_selected_apps (user_id);
+
+create table user_app_configs(
+       id bigserial primary key,
+       user_id integer unique not null references users on delete cascade,
+       root_domain varchar(100),
+       config_enc text
+       );
+
+create unique index user_app_configs_user_id_idx on user_app_configs (user_id);

src/db.scm

@@ -0,0 +1,327 @@
+(module nassella-db
+    (;; parameters
+     connection-spec
+
+     ;;functions
+     with-db with-db/transaction
+
+     create-user
+     update-user-service-config get-user-service-config
+     update-user-selected-apps get-user-selected-apps
+     update-user-app-config get-user-app-config
+     update-root-domain
+     )
+
+(import scheme
+        (chicken base)
+        (chicken blob)
+        (chicken file)
+        (chicken string)
+        (chicken port)
+        postgresql
+        sql-null
+        srfi-1
+        srfi-13
+        (openssl cipher)
+        (openssl random)
+        crypto-tools)
+
+(define connection-spec (make-parameter '((dbname . "nassella") (user . "nassella") (password . "password") (host . "127.0.0.1"))))
+(define db-connection (make-parameter #f))
+
+(define (with-db proc)
+  (if (db-connection)
+      (begin (db-connection)
+             (proc (db-connection)))
+      (let ((conn #f))
+        (dynamic-wind
+          (lambda ()
+            (set! conn (connect (connection-spec))))
+          (lambda () (proc conn))
+          (lambda ()
+            (when (and (connection? conn) (connected? conn))
+              (disconnect conn)))))))
+
+(define (with-db/transaction proc)
+  (with-db
+   (lambda (conn)
+     (with-transaction conn
+       (lambda () (proc conn))))))
+
+;; (with-db (lambda (db) (row-values (query db "select * from users;"))))
+
+(define aes-256-gcm (cipher-by-name "aes-256-gcm"))
+(define tag-length 16)
+
+(define (generate-param accessor)
+  (random-bytes (accessor aes-256-gcm)))
+
+(define (generate-key) (generate-param cipher-key-length))
+(define (generate-iv) (generate-param cipher-iv-length))
+
+(define (encrypt message key iv #!optional auth-data)
+  (string-encrypt-and-digest aes-256-gcm message key iv
+                             tag-length: tag-length
+                             auth-data: auth-data))
+
+(define (decrypt message tag key iv #!optional auth-data)
+  (string-decrypt-and-verify aes-256-gcm message tag key iv
+                             auth-data: auth-data))
+
+(define *root-key-file* "root-key")
+(define (generate-root-key) (generate-key))
+(define (save-root-key)
+  (with-output-to-file *root-key-file* (lambda () (write (blob->hexstring/uppercase (generate-root-key))))))
+(define (load-root-key)
+  (hexstring->blob (with-input-from-file *root-key-file* read)))
+
+(define *root-key-iv* (hexstring->blob "1EBBCF6B50C68593C559EF93"))
+(define (ensure-root-key)
+  (when (not (file-exists? *root-key-file*))
+    (save-root-key))
+  (load-root-key))
+(define *root-key-key* (ensure-root-key))
+
+(define (get-user-key-and-iv conn user-id)
+  (row-alist (query conn "select auth_user_id, key_key, key_iv from users where user_id=$1;" user-id)))
+
+(define (get-decrypted-user-key-and-iv conn user-id)
+  (let* ((auth-user-id-and-user-key-and-iv (get-user-key-and-iv conn user-id))
+         (raw-user-key-and-tag (alist-ref 'key_key auth-user-id-and-user-key-and-iv))
+         (raw-user-key (hexstring->blob (string-drop-right raw-user-key-and-tag (* tag-length 2))))
+         (raw-user-tag (hexstring->blob (string-take-right raw-user-key-and-tag (* tag-length 2))))
+         (user-key (decrypt (blob->string raw-user-key) (blob->string raw-user-tag) *root-key-key* *root-key-iv*
+                            (string->blob (number->string (alist-ref 'auth_user_id auth-user-id-and-user-key-and-iv)))))
+         (user-iv (alist-ref 'key_iv auth-user-id-and-user-key-and-iv))
+         (auth-user-id (alist-ref 'auth_user_id auth-user-id-and-user-key-and-iv)))
+    (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))))
+
+(define (user-encrypt-for-db message user-key user-iv user-id)
+  (receive (message tag)
+      (user-encrypt message user-key user-iv user-id)
+    (string-append (blob->hexstring/uppercase (string->blob message))
+                   (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))))
+
+(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))))
+        (raw-tag (hexstring->blob (string-take-right message-and-tag (* tag-length 2)))))
+    (user-decrypt (blob->string raw-message) (blob->string raw-tag) user-key user-iv user-id)))
+
+(define (create-user conn auth-user-id email username)
+  (let ((user-key (blob->hexstring/uppercase (generate-key)))
+        (user-iv (blob->hexstring/uppercase (generate-iv))))
+    (receive (enc-user-key tag)
+        (encrypt user-key *root-key-key* *root-key-iv* (string->blob (number->string auth-user-id)))
+      ;; (write user-key)
+      ;; (newline)
+      ;; (write user-iv)
+      ;; (newline)
+      ;; (write (blob->hexstring/uppercase (string->blob enc-user-key)))
+      ;; (newline)
+      ;; (write (blob->hexstring/uppercase (string->blob tag)))
+      (let ((user-id
+             (value-at
+              (query conn
+                     "insert into users(auth_user_id, email, username, key_key, key_iv) values ($1, $2, $3, $4, $5)
+returning users.user_id;"
+                     auth-user-id email username
+                     (string-append (blob->hexstring/uppercase (string->blob enc-user-key))
+                                    (blob->hexstring/uppercase (string->blob tag)))
+                     user-iv))))
+        (query conn "insert into user_service_configs(user_id) values ($1);" user-id)
+        (query conn "insert into user_selected_apps(user_id) values ($1);" user-id)
+        (query conn "insert into user_app_configs(user_id) values ($1);" user-id)))))
+
+(define *user-service-configs-column-map*
+  '((cloudflare-api-token . ("cloudflare_api_token_enc" #t))
+    (cloudflare-account-id . ("cloudflare_account_id_enc" #t))
+    (cloudflare-zone-id . ("cloudflare_zone_id_enc" #t))
+    (digitalocean-api-token . ("digitalocean_api_token_enc" #t))
+    (digitalocean-region . ("digitalocean_region" #f))
+    (digitalocean-size . ("digitalocean_size" #f))
+    (backblaze-application-key . ("backblaze_application_key_enc" #t))
+    (backblaze-key-id . ("backblaze_key_id_enc" #t))
+    (backblaze-bucket-url . ("backblaze_bucket_url_enc" #t))))
+
+(define *user-service-configs-reverse-column-map*
+  (map (lambda (config)
+         `(,(string->symbol (cadr config)) . (,(car config) ,(caddr config))))
+       *user-service-configs-column-map*))
+
+(define (update-user-service-config conn user-id update-alist)
+  (let ((valid-keys (map car *user-service-configs-column-map*)))
+    (for-each (lambda (update)
+                (if (not (memq (car update) valid-keys))
+                    (error (string-append "Not a valid update key: " (->string (car update))))))
+              update-alist))
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (query* conn
+            (string-append
+             "update user_service_configs set "
+             (string-intersperse
+              (map-in-order (lambda (update i)
+                              (conc (car (alist-ref (car update) *user-service-configs-column-map*))
+                                    "=$" i))
+                            update-alist
+                            (iota (length update-alist) 2))
+              ", ")
+             " where user_id=$1;")
+            (cons user-id
+                  (map-in-order (lambda (update)
+                                  (if (cadr (alist-ref (car update) *user-service-configs-column-map*))
+                                      (user-encrypt-for-db (cdr update) user-key user-iv user-id)
+                                      (cdr update)))
+                                update-alist)))))
+
+(define (get-user-service-config conn user-id)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (let ((res (row-alist
+                (query conn
+                       (string-append
+                        "select "
+                        (string-intersperse
+                         (map-in-order (lambda (update)
+                                         (car (alist-ref (car update) *user-service-configs-column-map*)))
+                                       *user-service-configs-column-map*)
+                         ", ")
+                        " from user_service_configs where user_id=$1;")
+                       user-id))))
+      (map (lambda (item)
+             (let* ((key (car item))
+                    (value (cdr item))
+                    (config (alist-ref key *user-service-configs-reverse-column-map*)))
+               `(,(car config) . ,(if (sql-null? value)
+                                      ""
+                                      (if (cadr config)
+                                          (user-decrypt-from-db value user-key user-iv user-id)
+                                          value)))))
+           res))))
+
+(define *user-selected-apps-column-map*
+  '((wg-easy . "wg_easy_version")
+    (nextcloud . "nextcloud_version")
+    (log-viewer . "log_viewer_version")))
+
+(define *user-selected-apps-reverse-column-map*
+  (map (lambda (config)
+         `(,(string->symbol (cdr config)) . ,(car config)))
+       *user-selected-apps-column-map*))
+
+(define (update-user-selected-apps conn user-id app-alist)
+  (let ((valid-keys (map car *user-selected-apps-column-map*)))
+    (for-each (lambda (app)
+                (if (not (memq (car app) valid-keys))
+                    (error (string-append "Not a valid app key: " (->string (car app))))))
+              app-alist))
+  (query* conn
+          (string-append
+           "update user_selected_apps set "
+           (string-intersperse
+            (map-in-order (lambda (app i)
+                            (conc (alist-ref (car app) *user-selected-apps-column-map*)
+                                  "=$" i))
+                          app-alist
+                          (iota (length app-alist) 2))
+            ", ")
+           " where user_id=$1;")
+          (cons user-id
+                (map-in-order cdr app-alist))))
+
+(define (get-user-selected-apps conn user-id)
+  (let ((res (row-alist
+              (query conn
+                     (string-append
+                      "select "
+                      (string-intersperse
+                       (map-in-order cdr *user-selected-apps-column-map*)
+                       ", ")
+                      " from user_selected_apps where user_id=$1;")
+                     user-id))))
+    (map (lambda (item)
+           (let* ((key (car item))
+                  (value (cdr item))
+                  (config (alist-ref key *user-selected-apps-reverse-column-map*)))
+             `(,config . ,(if (sql-null? value)
+                                    #f
+                                    value))))
+         res)))
+
+(define (update-user-app-config conn user-id config)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (query conn
+           "update user_app_configs set config_enc=$1 where user_id=$2;"
+           (user-encrypt-for-db
+            (with-output-to-string
+              (lambda ()
+                (write config)))
+            user-key user-iv user-id)
+           user-id)))
+
+(define (update-root-domain conn user-id root-domain)
+  (query conn
+         "update user_app_configs set root_domain=$1 where user_id=$2;"
+         root-domain
+         user-id))
+
+(define (get-user-app-config conn user-id)
+  (receive (user-key user-iv auth-user-id)
+      (get-decrypted-user-key-and-iv conn user-id)
+    (let ((res (row-alist (query conn
+                                 "select root_domain, config_enc from user_app_configs where user_id=$1;"
+                                 user-id))))
+      `((root-domain . ,(if (sql-null? (alist-ref 'root_domain res))
+                            #f
+                            (alist-ref 'root_domain res)))
+        (config . ,(if (sql-null? (alist-ref 'config_enc res))
+                       '()
+                       (with-input-from-string
+                           (user-decrypt-from-db (alist-ref 'config_enc res) user-key user-iv user-id)
+                         read)))))))
+
+;; (with-db/transaction (lambda (db) (create-user db 1 "t@thintz.com" "thecombjelly")))
+
+;; (let ((user-id 7))
+;;   (with-db/transaction
+;;    (lambda (db)
+;;      (receive (user-key user-iv auth-user-id)
+;;          (get-decrypted-user-key-and-iv db user-id)
+;;        (receive (message tag)
+;;            (user-encrypt "hello!" user-key user-iv user-id)
+;;          (user-decrypt message tag user-key user-iv user-id))))))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (update-user-service-config db 7 '((cloudflare-api-token . ")
+;;                                       (digitalocean-region . "sfo3")))))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (get-user-service-config db 7)))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (update-user-selected-apps db 7 '((wg-easy . "0.1")
+;;                                      (nextcloud . "1.3")))))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (get-user-selected-apps db 7)))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (update-user-app-config db 7 "domain.com" '())))
+
+;; (with-db/transaction
+;;  (lambda (db)
+;;    (get-user-app-config db 7)))
+
+)

src/nassella.scm

@@ -1,18 +1,25 @@
-(import sxml-transforms (chicken string) (chicken port) html-widgets
+(load "db.scm")
+
+(import (chicken string)
+        (chicken port)
+        (chicken io)
+        (chicken pretty-print)
+        (chicken process)
+        (chicken process-context)
+
+        (rename srfi-1 (delete srfi1:delete))
+
+        html-widgets
+        sxml-transforms
         (prefix schematra schematra:)
         schematra-body-parser
         schematra-session
-        (rename srfi-1 (delete srfi1:delete))
         uri-common
         http-client
         medea
         intarweb
-        (chicken io)
+        nassella-db
-        openssl
+        sql-null)
-        (chicken pretty-print)
-        (chicken io)
-        (chicken process)
-        (chicken process-context))
 
 (schematra:use-middleware! (body-parser-middleware))
 
@@ -273,7 +280,7 @@ h1, h2, h3, h4, h5, h6 {
                          '((meta (@ (name "viewport") (content "width=device-width"))))
                          (begin
                            ;; TODO remove once sessions are integrated
-                           (session-set! "user-id" "12345")
+                           (session-set! "user-id" 7)
                            (session-set! "username" "me")
                            body ...))))))))
 
@@ -456,41 +463,44 @@ h1, h2, h3, h4, h5, h6 {
                        (cursor "pointer"))))
             ,submit-button)))
 
-(define *data*
-  '())
-
 (get
  ("/config/wizard/services")
- `(App
+ (let ((config (with-db/transaction (lambda (db) (get-user-service-config db (session-get "user-id"))))))
-   (Configuration-Wizard
+   `(App
-    (@ (step "Services"))
+     (Configuration-Wizard
-    (form
+      (@ (step "Services"))
-     (@ (action "/config/wizard/services-submit")
+      (form
-        (method POST))
+       (@ (action "/config/wizard/services-submit")
-     (VStack
+          (method POST))
-      (Fieldset
+       (VStack
-       (@ (title "Cloudflare"))
+        (Fieldset
-       (Field (@ (name "cloudflare-api-token") (label ("API Token")) (value ,(alist-ref 'cloudflare-api-token *data*))))
+         (@ (title "Cloudflare"))
-       (Field (@ (name "cloudflare-zone-id") (label ("Zone ID")) (value ,(alist-ref 'cloudflare-zone-id *data*))))
+         (Field (@ (name "cloudflare-api-token") (label ("API Token")) (value ,(alist-ref 'cloudflare-api-token config))))
-       (Field (@ (name "cloudflare-account-id") (label ("Account ID")) (value ,(alist-ref 'cloudflare-account-id *data*)))))
+         (Field (@ (name "cloudflare-zone-id") (label ("Zone ID")) (value ,(alist-ref 'cloudflare-zone-id config))))
-      (Fieldset
+         (Field (@ (name "cloudflare-account-id") (label ("Account ID")) (value ,(alist-ref 'cloudflare-account-id config)))))
-       (@ (title "DigitalOcean"))
+        (Fieldset
-       (Field (@ (name "digitalocean-api-token") (label ("API Token")) (value ,(alist-ref 'digitalocean-api-token *data*)))))
+         (@ (title "DigitalOcean"))
-      (Fieldset
+         (Field (@ (name "digitalocean-api-token") (label ("API Token")) (value ,(alist-ref 'digitalocean-api-token config)))))
-       (@ (title "Backblaze"))
+        (Fieldset
-       (Field (@ (name "backblaze-application-key") (label ("Application Key")) (value ,(alist-ref 'backblaze-application-key *data*))))
+         (@ (title "Backblaze"))
-       (Field (@ (name "backblaze-key-id") (label ("Key ID")) (value ,(alist-ref 'backblaze-key-id *data*))))
+         (Field (@ (name "backblaze-application-key") (label ("Application Key")) (value ,(alist-ref 'backblaze-application-key config))))
-       (Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (value ,(alist-ref 'backblaze-bucket-url *data*)))))
+         (Field (@ (name "backblaze-key-id") (label ("Key ID")) (value ,(alist-ref 'backblaze-key-id config))))
-      (Form-Nav))))))
+         (Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (value ,(alist-ref 'backblaze-bucket-url config)))))
+        (Form-Nav)))))))
 
 (schematra:post ("/config/wizard/services-submit")
- (set! *data* (alist-update 'cloudflare-api-token (alist-ref 'cloudflare-api-token (schematra:current-params)) *data*))
+ (with-db/transaction
- (set! *data* (alist-update 'cloudflare-account-id (alist-ref 'cloudflare-account-id (schematra:current-params)) *data*))
+  (lambda (db)
- (set! *data* (alist-update 'cloudflare-zone-id (alist-ref 'cloudflare-zone-id (schematra:current-params)) *data*))
+    (update-user-service-config
- (set! *data* (alist-update 'digitalocean-api-token (alist-ref 'digitalocean-api-token (schematra:current-params)) *data*))
+     db
- (set! *data* (alist-update 'backblaze-application-key (alist-ref 'backblaze-application-key (schematra:current-params)) *data*))
+     (session-get "user-id")
- (set! *data* (alist-update 'backblaze-key-id (alist-ref 'backblaze-key-id (schematra:current-params)) *data*))
+     `((cloudflare-api-token . ,(alist-ref 'cloudflare-api-token (schematra:current-params)))
- (set! *data* (alist-update 'backblaze-bucket-url (alist-ref 'backblaze-bucket-url (schematra:current-params)) *data*))
+       (cloudflare-account-id . ,(alist-ref 'cloudflare-account-id (schematra:current-params)))
+       (cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (schematra:current-params)))
+       (digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (schematra:current-params)))
+       (backblaze-application-key . ,(alist-ref 'backblaze-application-key (schematra:current-params)))
+       (backblaze-key-id . ,(alist-ref 'backblaze-key-id (schematra:current-params)))
+       (backblaze-bucket-url . ,(alist-ref 'backblaze-bucket-url (schematra:current-params)))))))
  (schematra:redirect "/config/wizard/services-success"))
 
 (get
@@ -517,64 +527,98 @@ h1, h2, h3, h4, h5, h6 {
 
 (get
  ("/config/wizard/apps")
- `(App
+ (let ((results
-   (Configuration-Wizard
+        (with-db/transaction
-    (@ (step "Apps"))
+         (lambda (db)
-    (form
+           `((selected-apps . ,(map
-     (@ (action "/config/wizard/apps-submit") (method POST))
+                                car
-     (VStack
+                                (filter cdr
-      (Fieldset
+                                        (get-user-selected-apps db (session-get "user-id")))))
-       (@ (title "Root Domain"))
+             (app-config . ,(get-user-app-config db (session-get "user-id"))))))))
-       (Field (@ (element select) (name "root-domain"))
+   `(App
-              (option (@ (value (alist-ref 'root-domain *data*))) "nassella.cc")))
+     (Configuration-Wizard
-      (Fieldset
+      (@ (step "Apps"))
-       (@ (title "Selected Apps"))
+      (form
-       (Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps *data*)))))
+       (@ (action "/config/wizard/apps-submit") (method POST))
-       (Field (@ (name "nextcloud") (type "checkbox") (label ("NextCloud")) (checked ,(member 'wg-easy (alist-ref 'selected-apps *data*)))))
+       (VStack
-       (Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
+        (Fieldset
-      (Form-Nav (@ (back-to "/config/wizard/services-success"))))))))
+         (@ (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?
+        (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")))))))))
 
 (schematra:post ("/config/wizard/apps-submit")
-  (set! *data* (alist-update 'root-domain (alist-ref 'root-domain (schematra:current-params)) *data*))
+  (with-db/transaction
-  (set! *data* (alist-update 'selected-apps
+   (lambda (db)
-                             `(,@(if (alist-ref 'wg-easy (schematra:current-params)) '(wg-easy) '())
+     (update-user-selected-apps
-                               ,@(if (alist-ref 'nextcloud (schematra:current-params)) '(nextcloud) '())
+      db
-                               log-viewer)
+      (session-get "user-id")
-                             *data*))
+      `((wg-easy . ,(or (and (alist-ref 'wg-easy (schematra:current-params)) "0.0") (sql-null)))
+        (nextcloud . ,(or (and (alist-ref 'nextcloud (schematra:current-params)) "0.0") (sql-null)))))
+     (update-root-domain db (session-get "user-id") (alist-ref 'root-domain (schematra:current-params)))))
  (schematra:redirect "/config/wizard/apps2"))
 
 (get
  ("/config/wizard/apps2")
- `(App
+ (let* ((results
-   (Configuration-Wizard
+         (with-db/transaction
-    (@ (step "Apps"))
+          (lambda (db)
-    (form
+            `((selected-apps . ,(map
-     (@ (action "/config/wizard/apps2-submit") (method POST))
+                                 car
-     (VStack
+                                 (filter cdr
-      ,@(if (member 'wg-easy (alist-ref 'selected-apps *data*))
+                                         (get-user-selected-apps db (session-get "user-id")))))
-            `((Fieldset
+              (app-config . ,(get-user-app-config db (session-get "user-id")))))))
-               (@ (title "WG-Easy"))
+        (selected-apps (alist-ref 'selected-apps results))
-               (Field (@ (name "wg-easy-subdomain") (label ("Subdomain")) (value ,(alist-ref 'wg-easy-subdomain *data*))))))
+        (app-config (alist-ref 'app-config results)))
-            '())
+   `(App
-      ,@(if (member 'nextcloud (alist-ref 'selected-apps *data*))
+     (Configuration-Wizard
-            `((Fieldset
+      (@ (step "Apps"))
-               (@ (title "NextCloud"))
+      (form
-               (Field (@ (name "nextcloud-subdomain") (label ("Subdomain")) (value ,(alist-ref 'nextcloud-subdomain *data*))))
+       (@ (action "/config/wizard/apps2-submit") (method POST))
-               (Field (@ (name "nextcloud-admin-user") (label ("Admin Username")) (value ,(alist-ref 'nextcloud-admin-user *data*))))
+       (VStack
-               (Field (@ (name "nextcloud-admin-password") (label ("Admin Password")) (type "password") (value ,(alist-ref 'nextcloud-admin-password *data*))))))
+        ,@(if (member 'wg-easy selected-apps)
-            '())
+              `((Fieldset
-      (Fieldset
+                 (@ (title "WG-Easy"))
-       (@ (title "Log Viewer"))
+                 (Field (@ (name "wg-easy-subdomain") (label ("Subdomain")) (value ,(alist-ref 'subdomain (alist-ref 'wg-easy app-config eq? '()) eq? "wg-easy"))))))
-       (Field (@ (name "log-viewer-subdomain") (label ("Subdomain")) (value ,(alist-ref 'log-viewer-subdomain *data*))))
+              '())
-       (Field (@ (name "log-viewer-user") (label ("Username")) (value ,(alist-ref 'log-viewer-user *data*))))
+        ,@(if (member 'nextcloud selected-apps)
-       (Field (@ (name "log-viewer-password") (label ("Password")) (type "password") (value ,(alist-ref 'log-viewer-password *data*)))))
+              `((Fieldset
-      (Form-Nav (@ (back-to "/config/wizard/apps"))))))))
+                 (@ (title "NextCloud"))
+                 (Field (@ (name "nextcloud-subdomain") (label ("Subdomain"))
+                           (value ,(alist-ref 'subdomain (alist-ref 'nextcloud app-config eq? '()) eq? "nextcloud"))))
+                 (Field (@ (name "nextcloud-admin-user") (label ("Admin Username"))
+                           (value ,(alist-ref 'admin-user (alist-ref 'nextcloud app-config eq? '()) eq? "admin"))))
+                 (Field (@ (name "nextcloud-admin-password") (label ("Admin Password")) (type "password")
+                           (value ,(alist-ref 'admin-password (alist-ref 'nextcloud app-config eq? '()) eq? ""))))))
+              '())
+        (Fieldset
+         (@ (title "Log Viewer"))
+         (Field (@ (name "log-viewer-subdomain") (label ("Subdomain"))
+                   (value ,(alist-ref 'subdomain (alist-ref 'log-viewer app-config eq? '()) eq? "logs"))))
+         (Field (@ (name "log-viewer-user") (label ("Username"))
+                   (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")))))))))
 
 (schematra:post ("/config/wizard/apps2-submit")
- (set! *data* (alist-update 'nextcloud-admin-user (alist-ref 'nextcloud-admin-user (schematra:current-params)) *data*))
+  (with-db/transaction
- (set! *data* (alist-update 'nextcloud-admin-password (alist-ref 'nextcloud-admin-password (schematra:current-params)) *data*))
+   (lambda (db)
- (set! *data* (alist-update 'log-viewer-user (alist-ref 'log-viewer-user (schematra:current-params)) *data*))
+     (update-user-app-config
- (set! *data* (alist-update 'log-viewer-password (alist-ref 'log-viewer-password (schematra:current-params)) *data*))
+      db
+      (session-get "user-id")
+      `((wg-easy . ((subdomain . ,(alist-ref 'wg-easy-subdomain (schematra:current-params)))))
+        (nextcloud . ((subdomain . ,(alist-ref 'nextcloud-subdomain (schematra:current-params)))
+                      (admin-user . ,(alist-ref 'nextcloud-admin-user (schematra:current-params)))
+                      (admin-password . ,(alist-ref 'nextcloud-admin-password (schematra:current-params)))))
+        (log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (schematra:current-params)))
+                       (user . ,(alist-ref 'log-viewer-user (schematra:current-params)))
+                       (password . ,(alist-ref 'log-viewer-password (schematra:current-params)))))))))
  (schematra:redirect "/config/wizard/machine"))
 
 ;; Parsing JSON arrays as lists instead of vectors
@@ -611,30 +655,41 @@ h1, h2, h3, h4, h5, h6 {
 
 (get
  ("/config/wizard/machine")
- `(App
+ (let ((config (with-db/transaction
-   (Configuration-Wizard
+                (lambda (db)
-    (@ (step "Machine"))
+                  (get-user-service-config db (session-get "user-id"))))))
-    (form
+   `(App
-     (@ (action "/config/wizard/machine-submit")
+     (Configuration-Wizard
-        (method POST))
+      (@ (step "Machine"))
-     (VStack
+      (form
-      (Fieldset
+       (@ (action "/config/wizard/machine-submit")
-       (@ (title "Region"))
+          (method POST))
-       (Field (@ (element select) (name "region"))
+       (VStack
-              (option (@ (value "")) "")
+        (Fieldset
-              ,@(map (lambda (r)
+         (@ (title "Region"))
-                       `(option (@ (value ,(alist-ref 'slug r))) ,(alist-ref 'name r)))
+         (Field (@ (element select) (name "region"))
-                     (get-digital-ocean-regions (alist-ref 'digitalocean-api-token *data*)))))
+                (option (@ (value "")) "")
-      (Form-Nav (@ (back-to ,(conc "/config/wizard/apps2")))))))))
+                ,@(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"))))))))))
 
 (schematra:post ("/config/wizard/machine-submit")
- (set! *data* (alist-update 'digitalocean-region (alist-ref 'region (schematra:current-params)) *data*))
+ (with-db/transaction
+  (lambda (db)
+    (update-user-service-config
+     db
+     (session-get "user-id")
+     `((digitalocean-region . ,(alist-ref 'region (schematra:current-params)))))))
  (schematra:redirect "/config/wizard/machine2"))
 
 (get
  ("/config/wizard/machine2")
- (let* ((region (alist-ref 'digitalocean-region *data*))
+ (let* ((config (with-db/transaction
-        (all-sizes (get-digital-ocean-sizes (alist-ref 'digitalocean-api-token *data*)))
+                 (lambda (db)
+                   (get-user-service-config db (session-get "user-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)))
    `(App
      (Configuration-Wizard
@@ -657,74 +712,107 @@ h1, h2, h3, h4, h5, h6 {
         (Form-Nav (@ (back-to ,(conc "/config/wizard/machine"))))))))))
 
 (schematra:post ("/config/wizard/machine2-submit")
- (set! *data* (alist-update 'digitalocean-size (alist-ref 'size (schematra:current-params)) *data*))
+ (with-db/transaction
+  (lambda (db)
+    (update-user-service-config
+     db
+     (session-get "user-id")
+     `((digitalocean-size . ,(alist-ref 'size (schematra:current-params)))))))
  (schematra:redirect "/config/wizard/review"))
 
 (get
  ("/config/wizard/review")
- `(App
+ (let* ((results
-   (Configuration-Wizard
+         (with-db/transaction
-    (@ (step "Review"))
+          (lambda (db)
-    (h2 "Root Domain")
+            `((selected-apps . ,(map
-    ,(alist-ref 'root-domain *data*)
+                                 car
-    (h2 "Apps")
+                                 (filter cdr
-    (ul ,@(map (lambda (app) `(li ,app " @ "
+                                         (get-user-selected-apps db (session-get "user-id")))))
-                                  ,(alist-ref (string->symbol (conc (symbol->string app) "-subdomain")) *data*)
+              (app-config . ,(get-user-app-config db (session-get "user-id")))
-                                  "."
+              (service-config . ,(get-user-service-config db (session-get "user-id")))))))
-                                  ,(alist-ref 'root-domain *data*)))
+        (selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
-               (alist-ref 'selected-apps *data*)))
+        (app-config (alist-ref 'app-config results))
-    (h2 "Machine")
+        (config (alist-ref 'config app-config))
-    (ul (li "Region: " ,(alist-ref 'digitalocean-region *data*))
+        (root-domain (alist-ref 'root-domain app-config))
-        (li "Size: " ,(alist-ref 'digitalocean-size *data*)))
+        (service-config (alist-ref 'service-config results)))
-    (form
+   `(App
-     (@ (action "/config/wizard/review-submit") (method POST))
+     (Configuration-Wizard
-     (VStack
+      (@ (step "Review"))
-      (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch"))))))))
+      (h2 "Root Domain")
+      ,root-domain
+      (h2 "Apps")
+      (ul ,@(map (lambda (app) `(li ,app " @ "
+                                    ,(alist-ref 'subdomain (alist-ref app config))
+                                    "."
+                                    ,root-domain))
+                 selected-apps))
+      (h2 "Machine")
+      (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))
+       (VStack
+        (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch")))))))))
 
-(define (write-config-entry name key-or-value)
+(define (write-config-entry name value)
   (display name)
   (display "=\"")
-  (display (if (symbol? key-or-value) (alist-ref key-or-value *data*) key-or-value))
+  (display value)
   (print "\""))
 
 (schematra:post ("/config/wizard/review-submit")
-  (with-output-to-file "deploy/config/apps.config"
+ (let* ((results
-    (lambda ()
+         (with-db/transaction
-      (map (lambda (e)
+          (lambda (db)
-             (write-config-entry (car e) (cdr e)))
+            `((selected-apps . ,(map
-           `(("ROOT_DOMAIN" . root-domain)
+                                 car
-             ("APP_CONFIGS" . ,(string-intersperse
+                                 (filter cdr
-                                (map (lambda (app)
+                                         (get-user-selected-apps db (session-get "user-id")))))
-                                       (conc (if (eq? app 'log-viewer) 'dozzle app)
+              (app-config . ,(get-user-app-config db (session-get "user-id")))
-                                             ","
+              (service-config . ,(get-user-service-config db (session-get "user-id")))))))
-                                             (alist-ref (string->symbol (conc (symbol->string app) "-subdomain")) *data*)))
+        (selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
-                                     (alist-ref 'selected-apps *data*))
+        (app-config (alist-ref 'app-config results))
-                                " "))
+        (config (alist-ref 'config app-config))
-             ("HOST_ADMIN_USER" . log-viewer-user)
+        (root-domain (alist-ref 'root-domain app-config))
-             ("HOST_ADMIN_PASSWORD" . log-viewer-password)
+        (service-config (alist-ref 'service-config results)))
-             ("NEXTCLOUD_ADMIN_USER" . nextcloud-admin-user)
+   (with-output-to-file "deploy/config/apps.config"
-             ("NEXTCLOUD_ADMIN_PASSWORD" . nextcloud-admin-password)
+     (lambda ()
-             ("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
+       (map (lambda (e)
-             ("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
+              (write-config-entry (car e) (cdr e)))
-             ("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword")
+            `(("ROOT_DOMAIN" . ,root-domain)
-             ("NEXTCLOUD_REDIS_PASSWORD" . "redispassword")
+              ("APP_CONFIGS" . ,(string-intersperse
-             ("BACKBLAZE_KEY_ID" . backblaze-key-id)
+                                 (map (lambda (app)
-             ("BACKBLAZE_APPLICATION_KEY" . backblaze-application-key)
+                                        (conc (if (eq? app 'log-viewer) 'dozzle app)
-             ("BACKBLAZE_BUCKET_URL" . backblaze-bucket-url)
+                                              ","
-             ("RESTIC_PASSWORD" . "foodisgood")))))
+                                              (alist-ref 'subdomain (alist-ref app config))))
-  (with-output-to-file "deploy/config/production.tfvars"
+                                      selected-apps)
-    (lambda ()
+                                 " "))
-      (map (lambda (e)
+              ("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
-             (write-config-entry (car e) (cdr e)))
+              ("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config)))
-           `(("server_type" . digitalocean-size)
+              ("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
-             ("do_token" . digitalocean-api-token)
+              ("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
-             ("cloudflare_api_token" . cloudflare-api-token)
+              ("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
-             ("cloudflare_zone_id" . cloudflare-zone-id)
+              ("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
-             ("cloudflare_account_id" . cloudflare-account-id)
+              ("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword")
-             ("cluster_name" . "mycluster")
+              ("NEXTCLOUD_REDIS_PASSWORD" . "redispassword")
-             ("datacenter" . digitalocean-region)
+              ("BACKBLAZE_KEY_ID" . ,(alist-ref 'backblaze-key-id service-config))
-             ("flatcar_stable_version" . "4230.2.3")))
+              ("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
-      (display "ssh_keys=[\"") (display (with-input-from-file "deploy/config/ssh-keys" read-string)) (print "\"]")))
+              ("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
+              ("RESTIC_PASSWORD" . "foodisgood")))))
+   (with-output-to-file "deploy/config/production.tfvars"
+     (lambda ()
+       (map (lambda (e)
+              (write-config-entry (car e) (cdr e)))
+            `(("server_type" . ,(alist-ref 'digitalocean-size service-config))
+              ("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
+              ("cloudflare_api_token" . ,(alist-ref 'cloudflare-api-token service-config))
+              ("cloudflare_zone_id" . ,(alist-ref 'cloudflare-zone-id service-config))
+              ("cloudflare_account_id" . ,(alist-ref 'cloudflare-account-id service-config))
+              ("cluster_name" . "mycluster")
+              ("datacenter" . ,(alist-ref 'digitalocean-region service-config))
+              ("flatcar_stable_version" . "4230.2.3")))
+       (display "ssh_keys=[\"") (display (with-input-from-file "deploy/config/ssh-keys" read-string)) (print "\"]"))))
   (change-directory "deploy")
   (session-set! "pid" (process-run "make apply > make-out"))
   (change-directory "../")