Initial sketch of dashboard.

src/db.scm

@@ -17,6 +17,7 @@
      update-deployment-progress get-deployment-progress
      get-most-recent-deployment-progress
      update-user-terraform-state get-user-terraform-state
+     get-user-deployments
      )
 
 (import scheme
@@ -328,7 +329,9 @@ returning users.user_id;"
   '((generate-configs . "generate_configs")
     (custom-image . "terraform_custom_image")
     (machine-create . "terraform_machine_create")
-    (machine-destroy . "terraform_machine_destroy")))
+    (machine-destroy . "terraform_machine_destroy")
+    (status . "status")
+    (id . "id")))
 
 (define *deployments-reverse-column-map*
   (map (lambda (config)
@@ -393,6 +396,31 @@ returning users.user_id;"
                                     (string->symbol value)))))
          res)))
 
+(define (get-user-deployments conn user-id)
+  (let ((res (row-alist
+              (query conn
+                     (string-append
+                      "select "
+                      (string-intersperse
+                       (map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
+                       ", ")
+                      ", uac.root_domain"
+                      " from deployments as d "
+                      "join user_app_configs uac on uac.user_id = d.user_id"
+                      " where d.user_id=$1 order by d.id DESC limit 1;")
+                     user-id))))
+    (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 . ,(if (sql-null? value)
+                               #f
+                               (if (string? value)
+                                   (string->symbol value)
+                                   value)))))
+          res))))
+
 (define (update-user-terraform-state conn user-id state backup)
   (receive (user-key user-iv auth-user-id)
       (get-decrypted-user-key-and-iv conn user-id)
@@ -415,6 +443,7 @@ returning users.user_id;"
                        ""
                        (user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
 
+(with-db/transaction (lambda (db) (get-user-deployments db 7)))
 ;; (with-db/transaction (lambda (db) (get-most-recent-deployment-progress db 7)))
 ;; (with-db/transaction (lambda (db) (get-deployment-progress db 14)))
 ;; (with-db/transaction (lambda (db) (update-deployment-progress db 14 '((generate-configs . complete) (custom-image . in-progress) (machine-create . queued)))))

src/nassella.scm

@@ -416,6 +416,16 @@ h1, h2, h3, h4, h5, h6 {
      (h1 (@ (style ((font-size ,($ 'font.size.xxl))))) ,step)
      ,@contents)))
 
+(define-widget (Main-Container () contents)
+  `(VStack
+    (@ (style ((background ,($ 'color.primary.background))
+               (color ,($ 'color.primary.background-contrast))
+               (border-radius ,($ 'radius.large))
+               (padding ,($ 'gap.gutter)))))
+    ;; (header
+    ;;  (Steps (@ (steps ("Services" "Apps" "Machine" "Review")) (current ,step))))
+    ,@contents))
+
 (define-widget (Fieldset ((title "Title")) contents)
   `(VStack
     (@ (element fieldset)
@@ -441,6 +451,15 @@ h1, h2, h3, h4, h5, h6 {
       ,(if (equal? type "checkbox") input label)
       ,(if (equal? type "checkbox") label input))))
 
+(define-widget (Button ((type "submit")) contents)
+  `(button (@ (type ,type)
+              (style ((background ,($ 'color.primary))
+                      (color ,($ 'color.primary.contrast))
+                      (border-radius ,($ 'radius.medium))
+                      (border-color ,($ 'color.primary.shade))
+                      (cursor "pointer"))))
+           ,@contents))
+
 (define-widget (Form-Nav ((back-to #f) (submit-button "Next")))
   `(HStack
     (@ (style ((justify-content "space-between"))))
@@ -458,13 +477,7 @@ h1, h2, h3, h4, h5, h6 {
                         '()
                         '((pointer-events "none"))))))
        "Back")
-    (button (@ (type "submit")
+    (Button ,submit-button)))
-               (style ((background ,($ 'color.primary))
-                       (color ,($ 'color.primary.contrast))
-                       (border-radius ,($ 'radius.medium))
-                       (border-color ,($ 'color.primary.shade))
-                       (cursor "pointer"))))
-            ,submit-button)))
 
 (get
  ("/config/wizard/services")
@@ -919,5 +932,20 @@ h1, h2, h3, h4, h5, h6 {
      (pre ,output)
      )))
 
+(get
+ ("/dashboard")
+ `(App
+   (Main-Container
+    (main
+     (h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Deployments")
+     (Button "Setup New Deployment")
+     (ul ,@(map (lambda (deployment)
+                  `(li (a (@ (href ,(string-append "/deployments/" (number->string (alist-ref 'id deployment)))))
+                          ,(alist-ref 'root-domain deployment))
+                       " - ",(alist-ref 'status deployment)))
+                (with-db/transaction
+                 (lambda (db)
+                   (get-user-deployments db (session-get "user-id"))))))))))
+
 (schematra:schematra-install)
 (schematra:schematra-start)