web, frontend: fixes, select template by action

core/actor.lisp

@@ -60,7 +60,7 @@
 (defun ac-step (tsk bhv msg)
   (let ((*self* tsk))
     (handler-case (funcall bhv msg)
-      (error (err) 
+      (condition (err) 
              (invoke-debugger err)
              (util:lg :error "behavior" msg err)
              ))))

core/core.lisp

@@ -121,6 +121,7 @@
         (setf (gethash (config:name cfg) services) child)))))
 
 (defun handle-message (ctx msg)
+  (util:lgd ctx msg)
   (do-actions ctx msg))
 
 (defun do-actions (ctx msg &optional (acts #'actions))

frontend/cs-hx.lisp

@@ -14,12 +14,28 @@
 
 (in-package :scopes/frontend/cs-hx)
 
+(defvar *templates* (make-hash-table))
+
 (defclass response (response:html-response) ())
 
 (defmethod response:render-content ((resp response) msg)
   ;(dom:render (dom:dlist nil (shape:data msg))))
-  (dom:render
-    (div nil (util:loop-plist (shape:data msg) k v collect (view-field k v)))))
+  (let ((tmpl (gethash (shape:head-value msg :action) *templates*)))
+    (dom:render (funcall tmpl resp msg))))
+
+(defun view (resp msg)
+  (div nil (util:loop-plist (shape:data msg) k v collect (view-field k v))))
+
+(defun form (resp msg)
+  (let* ((data (shape:data msg))
+         (fields (getf data :fields)))
+    (mapcar (lambda (f) (form-field f)) fields)))
 
 (defun view-field (label value)
   (div nil (label nil label) ": " value))
+
+(defun form-field (name)
+  (div nil (label nil name) ": " name))
+
+(setf (gethash :view *templates*) #'view)
+(setf (gethash :form *templates*) #'form)

lib/auth/auth.lisp

@@ -69,7 +69,7 @@
 
 (defgeneric principal-id (prc)
   (:method ((prc principal))
-    (head-value :name prc)))
+    (shape:head-value :name prc)))
 
 ;;;; login entry point
 

lib/auth/web.lisp

@@ -16,10 +16,10 @@
 (in-package :scopes-auth/web)
 
 (defun login-form (ctx msg)
-  (let ((msg (message:create '(:html :render :form :login)
-                             :data '(:fields (:login :password) :button "Login")
-                             :customer (actor:customer msg))))
-    (core:echo ctx msg)))
+  (let ((mso (message:create '(:auth :form :login)
+                             :data '(:fields (:login :password) :button "Login"))))
+    (actor:send (actor:customer msg) mso)
+    ))
 
 (defun login (ctx msg)
   (let* ((prc (auth:login (shape:data msg))))

web/response.lisp

@@ -30,7 +30,8 @@
 
 (defvar *default-actions* 
   (core:define-actions '((:response :set-cookie) set-cookie) 
-                       '(nil render-msg)))
+                       '(nil render-msg)
+                       ))
 
 (defun render-cookie (cdata)
   (let ((cookie (apply #'cookie:create-from-keys cdata)))

web/server.lisp

@@ -92,7 +92,7 @@
          (msg (message:create (head env) 
                               :data (plist (post-data env)) 
                               :customer (core:mailbox resp))))
-    (util:lgd msg)
+    ;(util:lgd msg)
     ; (check-auth ctx msg env) => (response:render-unauthorized resp)
     (if (core:handle-message ctx msg)
       (response:render resp)